VBA初學:零件成本統計之一(任務匯總)

經過前期一年多對金蝶K3生產任務流程和操作的改造和優化,現在總算可以將零件加工各個環節的成本進行歸集了。
原本想寫存儲過程,通過直接SQL報表做到K3中去的,但財務原本就是用EXCEL,可以方便調整和保存,加上還有一部分成本費用需要先分攤再做進去的,所以用VBA做了這個表格。

第一步,是獲取機加任務及工時
在目錄頁中,各按鈕代碼如下,順便將點擊日期保存,以備查
在這里插入圖片描述

Private Sub CommandButton1_Click()Startview.Show 0CommandButton1.Enabled = FalseActiveSheet.Range("C3") = Now()
End SubPrivate Sub CommandButton2_Click()summary.statisticalCommandButton2.Enabled = FalseActiveSheet.Range("C4") = Now()
End SubPrivate Sub CommandButton3_Click()count.countCommandButton3.Enabled = FalseActiveSheet.Range("C6") = Now()
End SubPrivate Sub CommandButton4_Click()
CommandButton1.Enabled = True
End SubPrivate Sub CommandButton5_Click()
CommandButton2.Enabled = True
End SubPrivate Sub CommandButton6_Click()
CommandButton3.Enabled = True
End SubPrivate Sub CommandButton7_Click()CLWX_JE.getjeCommandButton7.Enabled = FalseActiveSheet.Range("C5") = Now()
End SubPrivate Sub CommandButton8_Click()
CommandButton7.Enabled = True
End Sub

點擊“獲取任務”會跳出一個界面,點擊是后進行查詢。
在這里插入圖片描述

“確認”按鈕代碼如下

  Option ExplicitPublic daymark As Boolean'獲取傳入月份的最大日期Function maxday(year As Integer, month As Integer) As Integermaxday = Day(DateSerial(year, month + 1, 1) - 1)End Function'確認,獲取任務
Private Sub ButtonEnter_Click()gettask.getdateEnd Sub'起始年的CHANGE事件
Private Sub ComboBox1_Change()Dim i As IntegerFor i = 2000 To 3000Me.ComboBox1.AddItem iNextEnd Sub
'起始年變更后獲取起始日期
Private Sub ComboBox1_Click()Me.Sdate.Caption = Me.ComboBox1.Value & "-" & Me.ComboBox2.Value & "-" & Me.ComboBox3.Value
End Sub
'起始月的CHANGE事件
Private Sub ComboBox2_Change()Me.ComboBox2.List = Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12")
End Sub'起始月變更后獲取起始日期
Private Sub ComboBox2_Click()Me.Sdate.Caption = Me.ComboBox1.Value & "-" & Me.ComboBox2.Value & "-" & Me.ComboBox3.ValueDim i As IntegerMe.ComboBox3.ClearFor i = 1 To maxday(Me.ComboBox1.Value, Me.ComboBox2.Value)Me.ComboBox3.AddItem iNext
End Sub
'起始日的CHANGE事件
Private Sub ComboBox3_Change()
'   當點擊日期時,進行選擇Dim i As IntegerFor i = 1 To maxday(Me.ComboBox1.Value, Me.ComboBox2.Value)Me.ComboBox3.AddItem iNextEnd Sub
'起始日變更后獲取起始日期
Private Sub ComboBox3_Click()Me.Sdate.Caption = Me.ComboBox1.Value & "-" & Me.ComboBox2.Value & "-" & Me.ComboBox3.Value
End Sub
'起始日變更后確認起始日期
Private Sub ComboBox3_Enter()Me.Sdate.Caption = Me.ComboBox1.Value & "-" & Me.ComboBox2.Value & "-" & Me.ComboBox3.ValueIf Me.ComboBox2.Value > 12 Or Me.ComboBox2.Value <= 0 ThenMsgBox "起始月份有錯誤"End IfIf Me.ComboBox3.Value > maxday(Me.ComboBox1.Value, Me.ComboBox2.Value) Or Me.ComboBox3.Value <= 0 ThenMsgBox "起始日期有錯誤"End IfEnd Sub
'結束年的CHANGE事件
Private Sub ComboBox4_Change()Dim i As IntegerFor i = 2000 To 3000Me.ComboBox4.AddItem iNextEnd Sub'結束年變更后獲取結束日期
Private Sub ComboBox4_Click()Me.Edate.Caption = Me.ComboBox4.Value & "-" & Me.ComboBox5.Value & "-" & Me.ComboBox6.Value
End Sub
'結束月的CHANGE事件
Private Sub ComboBox5_Change()Me.ComboBox5.List = Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12")
End Sub
'結束月變更后獲取結束日期
Private Sub ComboBox5_Click()Me.Edate.Caption = Me.ComboBox4.Value & "-" & Me.ComboBox5.Value & "-" & Me.ComboBox6.Value'當點擊月份要做更改時,日期隨之變化Dim i As IntegerMe.ComboBox6.ClearFor i = 1 To maxday(Me.ComboBox4.Value, Me.ComboBox5.Value)Me.ComboBox6.AddItem iNextEnd Sub'結束日的CHANGE事件
Private Sub ComboBox6_Change()'   當點擊日期時,進行選擇Dim i As IntegerFor i = 1 To maxday(Me.ComboBox4.Value, Me.ComboBox5.Value)Me.ComboBox6.AddItem iNextEnd Sub
'結束日變更后獲取結束日期
Private Sub ComboBox6_Click()Me.Edate.Caption = Me.ComboBox4.Value & "-" & Me.ComboBox5.Value & "-" & Me.ComboBox6.Value
End Sub
'結束日確認后獲取結束日期
Private Sub ComboBox6_Enter()Me.Edate.Caption = Me.ComboBox4.Value & "-" & Me.ComboBox5.Value & "-" & Me.ComboBox6.ValueIf Me.ComboBox5.Value > 12 Or Me.ComboBox5.Value <= 0 ThenMsgBox "結束月份有錯誤"End IfIf Me.ComboBox6.Value > maxday(Me.ComboBox4.Value, Me.ComboBox5.Value) Or Me.ComboBox6.Value <= 0 ThenMsgBox "結束日期有錯誤"End IfEnd Sub'界面初始化
Private Sub UserForm_Initialize()
'    daymark = TrueMe.ComboBox1.Value = year(Now())Me.ComboBox2.Value = month(Now())Me.ComboBox3.Value = Day(Now())Me.ComboBox4.Value = year(Now())Me.ComboBox5.Value = month(Now())Me.ComboBox6.Value = Day(Now())Me.Sdate.Caption = Me.ComboBox1.Value & "-" & Me.ComboBox2.Value & "-" & Me.ComboBox3.ValueMe.Edate.Caption = Me.ComboBox4.Value & "-" & Me.ComboBox5.Value & "-" & Me.ComboBox6.ValueMe.Sdate.Visible = FalseMe.Edate.Visible = FalseEnd Sub

點擊確認后,調用 gettask.getdate,獲取起始至結束日期內的任務

 Sub getdate()Dim sqlstr As StringDim WS As WorksheetDim rng As RangeDim sheetName As StringDim i As Long, MAXRGN As LongDim objRecDim objConnDim Sdate As Variant, Edate As VariantDim response As VbMsgBoxResultApplication.ScreenUpdating = False  '關閉屏幕更新,加快程序運行
Application.DisplayAlerts = False   '不顯示警告信息'獲取起止時間Sdate = Startview.Sdate.CaptionEdate = Startview.Edate.CaptionIf Sdate <= Edate Thenresponse = MsgBox("查詢的日期是:" & Sdate & "至" & Edate & "嗎?", vbQuestion + vbYesNo, "確認")If response = vbYes ThenGoTo continueElseExit SubEnd IfElseMsgBox "查詢時間段設置有誤,請檢查"Exit SubEnd If
continue:Unload Startview'''''''''檢查工作表是否存在,不存在則新建一個' 設置要檢查的工作表名稱sheetName = "機加任務及工時"
'    ' 遍歷工作簿中的所有工作表,檢查是否存在同名工作表For Each WS In ThisWorkbook.SheetsIf WS.Name = sheetName Theni = 1End IfNext'如果沒有則新增If i = 0 ThenSet WS = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.count))WS.Name = sheetNameEnd If'清除原有數據ActiveWorkbook.Sheets(sheetName).SelectMAXRGN = Worksheets(sheetName).Range("a" & Rows.count).End(xlUp).RowIf MAXRGN <> 0 ThenSet rng = ActiveSheet.Range("A1:AZ" & MAXRGN)rng.Borders.LineStyle = xlNone  ' 移除邊框rng.Clear ' 清除數據End If'查詢語句sqlstr = sqlstr + "  select t1.finterid,t1.FBillNo ,t_Item.fname type,t1.FNote,t2.FNumber,t2.FName, t2.FModel,t1.FQty,  "sqlstr = sqlstr + " convert(varchar,T1.FCommitDate,23) rwxdrq,convert(varchar,t1.fheadselfj01111,23) rkrq,   "sqlstr = sqlstr + "t4.FItemID,t4.FName,t3.Fmaketime   from icmo t1 inner join t_icitem  t2 on t1.fitemid=t2.FItemID "sqlstr = sqlstr + " left join t_BOS257800028Entry2  t3  on t3.FID_SRC=t1.FInterID and t3.FBillNo_SRC1=t1.FBillNo "sqlstr = sqlstr + " left join t_Item_3005 t4 on t3.FBase4=t4.FItemID "sqlstr = sqlstr + " left join t_Item on t_item.fitemid=t1.FHeadSelfJ01100 and t_item.FItemClassID=3002 "sqlstr = sqlstr + "where t1.fheadselfj01111 >=" & "'" & Sdate & "'" & "  and t1.fheadselfj01111<=" & "'" & Edate & "'" & "order by t1.finterid"
'''''''''''''''''''''''''''''''''''''''''''使用方法一或方法二時解除注釋
''''定義連接對象Set objRec = CreateObject("ADODB.Recordset")Set objConn = CreateObject("ADODB.Connection")
''''''''''''''''''''''''''''''''''''''''''
'''方法一: 數據量大時速度較慢
''        '執行查詢并獲取結果集
''    連接數據庫并執行SQL語句objConn.ConnectionString = "Provider=SQLOLEDB;Data Source=192.168.100.3;Initial Catalog=AIS20150813141843;User ID=sa;Password=Chr_2016"objConn.OpenSet objRec = objConn.Execute(sqlstr)If Not objRec.EOF Then''    '將結果集保存到工作表Set WS = ThisWorkbook.Worksheets(sheetName) ''將標題寫入工作表For i = 0 To objRec.Fields.count - 1WS.Cells(1, i + 1).Value = objRec.Fields(i).NameNext iActiveSheet.Range("A2").CopyFromRecordset objRec
''使用方法一或方法二時解除注釋
''    關閉記錄集和連接objRec.CloseobjConn.Close'
'    '釋放對象Set objRec = NothingSet objConn = NothingElseMsgBox "沒有數據,請重新選擇時間段"Exit SubEnd If'''''''''''''''''''''''''''''''''''''''
''''方法二:速度比方法一快,且自帶標題(WPS下有效,但EXCEL下報錯)
''
''     執行查詢并將結果存儲在記錄集對象中
''    '連接數據庫并執行SQL語句
''    objConn.ConnectionString = "Provider=SQLOLEDB;Data Source=192.168.100.3;Initial Catalog=AIS20150813141843;User ID=sa;Password=Chr_2016"
''
''    objConn.Open
''    objRec.Open sqlstr, objConn
''
''    If Not objRec.EOF Then
''
''     設置工作表對象
''    Set WS = ThisWorkbook.Sheets(sheetName) ' 可以更改為你要寫入數據的工作表名稱
''     將數據寫入工作表
''    With WS.QueryTables.Add(Connection:=objRec, Destination:=WS.Range("A1"))
''''        .TextFileParseType = xlFixedWidth '指示將文件中的數據排列在固定寬度的列中'xlDelimited 默認值。 指示文件由分隔符分隔
''''        .TextFileCommaDelimiter = True ' 根據需要更改分隔符,這里使用逗號作為分隔符
''''        .Refresh BackgroundQuery:=False  ' 或使用 .Execute,然后在下一行添加總計行(如果有)并刷新查詢表格以獲取數據。
''        .Refresh
''    End With
''''使用方法一或方法二時解除注釋
'''    關閉記錄集和連接
''    objRec.Close
''    objConn.Close
''
'''
''    '釋放對象
''    Set objRec = Nothing
''    Set objConn = Nothing
'
'
''   Else
''
''     MsgBox "沒有數據,請重新選擇時間段"
''     Exit Sub
''    End If''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''方法三:此方法在WPS下報錯,但在EXCEL中能執行成功
''  ActiveWorkbook.Queries(1).Delete
''    ActiveWorkbook.Queries.Add Name:="查詢1", Formula:= _
''        "let" & Chr(13) & "" & Chr(10) & "    源 = Odbc.Query(""dsn=CHR"", """ & sqlstr & """)," _
''        & Chr(13) & "" & Chr(10) & "    重命名的列 = Table.RenameColumns(源,{{""FName"", ""FName.1""}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    重命名的列" & ""
'
'    ActiveWorkbook.Queries.Add Name:="查詢1", Formula:= _
'        "let" & Chr(13) & "" & Chr(10) & "    源 = Odbc.Query(""dsn=CHR"", """ & sqlstr & """)" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    源" & ""
'
'
'   ''     設置工作表對象
'    Set WS = ThisWorkbook.Sheets(sheetName) ' 可以更改為你要寫入數據的工作表名稱
'    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
'        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=查詢1;Extended Properties=""""" _
'        , Destination:=WS.Range("$A$1")).QueryTable
'        .CommandType = xlCmdSql
'        .CommandText = Array("SELECT * FROM [查詢1]")
'        .RowNumbers = False
''        .FillAdjacentFormulas = False
''        .PreserveFormatting = True
''        .RefreshOnFileOpen = False
''        .BackgroundQuery = True
''        .RefreshStyle = xlInsertDeleteCells
''        .SavePassword = False
''        .SaveData = True
''        .AdjustColumnWidth = True
''        .RefreshPeriod = 0
''        .PreserveColumnInfo = False
''        .ListObject.DisplayName = "查詢1"
'        .Refresh BackgroundQuery:=True '后臺進行查詢,false時會跳出對話框
'    End With
''    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
'   ActiveWorkbook.Queries(1).Delete '刪除查詢''''''''''''''''''''''''''''''''moformat.format
Application.ScreenUpdating = True
Application.DisplayAlerts = TrueSheets("目錄").SelectEnd Sub

查詢出的結果 ,有任務的相關信息和所用的工序和工時
在這里插入圖片描述

本文來自互聯網用戶投稿,該文觀點僅代表作者本人,不代表本站立場。本站僅提供信息存儲空間服務,不擁有所有權,不承擔相關法律責任。
如若轉載,請注明出處:http://www.pswp.cn/web/40757.shtml
繁體地址,請注明出處:http://hk.pswp.cn/web/40757.shtml
英文地址,請注明出處:http://en.pswp.cn/web/40757.shtml

如若內容造成侵權/違法違規/事實不符,請聯系多彩編程網進行投訴反饋email:809451989@qq.com,一經查實,立即刪除!

相關文章

便攜式氣象站:探索自然的智慧伙伴

在探索自然奧秘、追求科學真理的道路上&#xff0c;氣象數據始終是我們不可或缺的指引。然而&#xff0c;傳統的氣象站往往龐大而笨重&#xff0c;難以在偏遠地區或移動環境中靈活部署。 便攜式氣象站&#xff0c;顧名思義&#xff0c;是一種小巧輕便、易于攜帶和安裝的氣象觀測…

模擬面試002-Java開發工程師+簡歷+問題+回答

模擬面試002-Java開發工程師簡歷問題回答 目錄 模擬面試002-Java開發工程師簡歷問題回答面試簡歷面試官題問Java基礎與編程框架與工具數據庫與性能優化項目經驗與實踐團隊合作與溝通 求職者回答Java基礎與編程框架與工具數據庫與性能優化項目經驗與實踐團隊合作與溝通 參考資料…

由于找不到xinput1 3.dll無法繼續執行重新安裝程序

如果您的計算機提示無法找到xinput1_3.dll文件&#xff0c;這可能表明您的計算機存在問題。在這種情況下&#xff0c;您需要立即對xinput1_3.dll文件進行修復&#xff0c;否則您的某些程序將無法啟動。以下是解決無法找到xinput1_3.dll文件的方法。 一、關于xinput1_3.dll文件的…

你要允許此應用對你的設備進行更改嗎

在Windows 11中&#xff0c;當你看到提示“你要允許此應用對你的設備進行更改嗎&#xff1f;”時&#xff0c;這是系統檢測到某個應用或軟件試圖對你的設備進行更改或安裝的提醒。這個提示是為了保護你的系統免受潛在惡意軟件的侵害。如果你選擇“是”&#xff0c;則應用可以繼…

Elasticsearch 實現 Word、PDF,TXT 文件的全文內容提取與檢索

文章目錄 一、安裝軟件:1.通過docker安裝好Es、kibana安裝kibana:2.安裝原文檢索與分詞插件:之后我們可以通過doc命令查看下載的鏡像以及運行的狀態:二、創建管道pipeline名稱為attachment二、創建索引映射:用于存放上傳文件的信息三、SpringBoot整合對于原文檢索1、導入依賴…

安全及應用(更新)

一、賬號安全 1.1系統帳號清理 #查看/sbin/nologin結尾的文件并統計 [rootrootlocalhost ~]# grep /sbin/nologin$ /etc/passwd |wc -l 40#查看apache登錄的shell [rootrootlocalhost ~]# grep apache /etc/passwd apache:x:48:48:Apache:/usr/share/httpd:/sbin/nologin#改變…

Android增量更新----java版

一、背景 開發過程中&#xff0c;隨著apk包越來越大&#xff0c;全量更新會使得耗時&#xff0c;同時浪費流量&#xff0c;為了節省時間&#xff0c;使用增量更新解決。網上很多文章都不是很清楚&#xff0c;沒有手把手教學&#xff0c;使得很多初學者&#xff0c;摸不著頭腦&a…

2011年的數字IC設計面經

2011年老羅寫的面經&#xff0c;轉眼間2024年了&#xff0c;大家湊合著看吧&#xff0c;可以順便看看2011年的應屆生薪資。 本人通信工程碩士&#xff0c;非電子科班出身&#xff0c;主要找數字IC設計的工作&#xff0c;找工作找了一個月左右&#xff0c;還算滿意吧&#xff0…

邊緣概率密度、條件概率密度、邊緣分布函數、聯合分布函數關系

目錄 二維隨機變量及其分布離散型隨機變量連續型隨機變量邊緣分布邊緣概率密度舉例邊緣概率密度 條件概率密度邊緣概率密度與條件概率密度的區別邊緣概率密度條件概率密度舉個具體例子 參考資料 二維隨機變量及其分布 離散型隨機變量 把所有的概率&#xff0c;都理解成不同質量…

R迅速切換目錄 -R語言002

實用小操作系列 R定位當前目錄 getwd() [1] "/data/Rprofile1" #當前工作目錄&#xff0c;因為他讀取文件都是相對路徑&#xff0c;進當前目錄&#xff0c;一般不考慮絕對路徑&#xff0c;寫代碼容易亂呀&#xff0c;切目錄最簡單完善 R切換工作目錄 setwd(&q…

邏輯圖框架圖等結構圖類圖的高效制作方式不妨進來看看

**邏輯圖框架圖等結構圖類圖的高效制作方式不妨進來看看** 基于我們每天都在處理大量的數據和信息。為了更清晰地理解和傳達這些信息&#xff0c;結構圖、邏輯圖和框架圖等可視化工具變得越來越重要。然而&#xff0c;如何高效地制作這些圖表并確保其準確性和易讀性呢&#xf…

RedHat運維-LinuxSELinux基礎4-端口綁定SELinux上下文

1. SELinux將一個_________與一個SELinux上下文相連接&#xff1b; 2. SSH協議將22/tcp端口與__________SELinux上下文相聯系&#xff1b; 3. HTTP協議將80/tcp、443/tcp端口與____________SELinux上下文相聯系&#xff1b; 4. 列出所有端口的SELinux上下文信息的方法是_______…

Mongodb索引簡介

學習mongodb&#xff0c;體會mongodb的每一個使用細節&#xff0c;歡迎閱讀威贊的文章。這是威贊發布的第84篇mongodb技術文章&#xff0c;歡迎瀏覽本專欄威贊發布的其他文章。如果您認為我的文章對您有幫助或者解決您的問題&#xff0c;歡迎在文章下面點個贊&#xff0c;或者關…

Windows密碼憑證獲取

Windows HASH HASH簡介 hash &#xff0c;一般翻譯做散列&#xff0c;或音譯為哈希&#xff0c;所謂哈希&#xff0c;就是使用一種加密函數進行計算后的結果。這個 加密函數對一個任意長度的字符串數據進行一次數學加密函數運算&#xff0c;然后返回一個固定長度的字符串。…

常用字符集與亂碼原因

1.ASCII字符集&#xff1a;僅對英文字符編碼&#xff0c;每個字符用1B編碼&#xff0c;7位二進制足以表示所有ASCII字符集&#xff0c;因此最高位始終為0 2.GBK字符集&#xff1a;GB2312字符集&#xff08;簡體中文字符集&#xff09;BIG5字符集&#xff08;臺灣地區繁體中文字…

服裝購物商城系統小程序-計算機畢業設計源碼35058

摘要 服裝購物商城系統小程序&#xff0c;依托Spring Boot框架的強大支持&#xff0c;為用戶呈現了一個功能豐富、體驗流暢的在線購物平臺。該系統不僅涵蓋了商品展示、用戶注冊登錄、購物車管理、訂單處理、支付集成等核心購物流程&#xff0c;還引入了個性化推薦算法&#xf…

Jmeter使用JSON Extractor提取多個變量

1.當正則不好使時&#xff0c;用json extractor 2.提取多個值時&#xff0c;默認值必填&#xff0c;否則讀不到變量

什么是集港??貨代小白快來點贊收藏-深圳全球利物流有限公司

集港是什么意思? 集港的定義 集港是指將分散在各處的集裝箱集中到港口碼頭堆場的過程&#xff0c;即把各地的集裝箱匯集到港區&#xff0c;準備裝船。在船掛靠碼頭之前&#xff0c;碼頭會制定集港計劃&#xff0c;安排貨船的集裝箱在某個時間段內進入碼頭并擺放好&#xff0c;…

【js】this指向問題

1.首先先明確&#xff0c;this會出現在哪里。 this出現在全局作用域中&#xff0c;或函數作用域中&#xff08;普通函數、箭頭函數&#xff09;。 對象是不產生作用域的&#xff0c;對象的{}和函數的{}不一樣&#xff0c;this并不會直接出現在對象或類中&#xff0c;只會出現在…

Android SurfaceFlinger——屏幕狀態初始化(二十二)

對于開機啟動動畫前期準備的相關步驟,我們已經分析了前 5 個,對于第 6 步調用 eglGetDisplay() 函數對 OpenGL ES 初始化并獲取默認屏幕,我們在介紹 OpenGL ES 的時候也進行了詳細的分析,下一步我們我們來分析對屏幕的狀態進行初始化。 1)getInternalDisplayToken:獲取顯…