加入 CodeStore VBA 模組

2026-08-18 00:39:40 +08:00
1 parent 9c5364f88e
commit 0e638bdd15
@@ -0,0 +1,77 @@
+Attribute VB_Name = "工作表9"
+'**************** 程式變數 ******************
+'Const PYEAR = 2020                              '年度
+'Const PCOMPANY = 11                             '公司代碼
+'Const strXLSfile = "\制服.xlsm"                 '資料來源
+'Const strLookup = "中油嘉義"                  '使用程式的學校
+Const ITEMcount = 5                             '匯入處理品項數目
+Const intFieldAmount = 22                       '表中欄位數目
+Const xlsRANGE = "[引數$J1:K23]"              '排序引數表中位置
+Const intFLeft = 23                             '填入表格左邊界
+
+Private Sub CommandButton1_Click()
+Dim strSQL As String
+On Error GoTo Err_cmdYes_Click
+
+Application.Calculation = xlManual '設置手動重算
+'查詢欄位名稱table
+Dim Cnxn As New ADODB.Connection
+Set Cnxn = Cnxnopen(XLSfile, "1")
+
+   Range("W2:AF28").Clear              '清除使用範圍儲存格
+   Call FfName(Cnxn, "校裙", 2)
+'    Call FfName(Cnxn, "短袖", 9)
+'    Call FfName(Cnxn, "長褲", 16)
+'    Call FfName(Cnxn, "夾克", 23)
+'
+Application.Calculation = xlAutomatic ' 設置自動重算
+Cnxn.Close
+Set Cnxn = Nothing
+
+Exit_cmdYes_Click:
+   Exit Sub
+
+Err_cmdYes_Click:
+   MsgBox Err.Description
+   Resume Exit_cmdYes_Click
+
+End Sub
+
+Private Sub FfName(Cnxn As ADODB.Connection, strItem As String, intRow As Integer)
+' intRange  男、女、全      1,2,3
+' intRow    填表行位置
+Dim rstFfname As New ADODB.Recordset
+Dim strSQL As String
+Dim intRowLoc As Integer
+           'select 尺碼,男人數,男數量,女人數,女數量,合計
+   strSQL = "Select " & strItem & "尺碼,sum(IIf(性別='男',1,0))," & "sum(IIf(性別='男'," & strItem & "訂購,0))," & _
+           "sum(IIf(性別='男',0,1)),sum(IIf(性別='男',0," & strItem & "訂購))," & "sum(" & strItem & "訂購)," & xlsRANGE & ".id " & _
+           "FROM [異動$] INNER JOIN " & xlsRANGE & " ON " & xlsRANGE & ".strorder = [異動$]." & strItem & "尺碼" & _
+           " WHERE isnull([異動$].員編)" & _
+           " GROUP BY " & xlsRANGE & ".id,[異動$]." & strItem & "尺碼" & _
+           " ORDER BY " & xlsRANGE & ".id;"
+'    Debug.Print strSQL
+   rstFfname.Open strSQL, Cnxn, adOpenStatic, adLockOptimistic, adCmdText
+   '填入項目
+   For intJ = 1 To WorksheetFunction.RoundUp(rstFfname.RecordCount / intFieldAmount, 0)         '行數目限制
+       intRowLoc = IIf(intJ <> 1, intRow + (2 * (intJ - 1)), intRow)                       'intJ表一範圍
+   For intI = 1 To intFieldAmount
+     If Not rstFfname.EOF Then
+       For intK = 0 To 5                                         '行填入位置
+           Cells(intRowLoc + intK, intFLeft + intI).Borders.LineStyle = xlContinuous
+           Cells(intRowLoc + intK, intFLeft + intI).value = rstFfname.Fields(intK)
+       Next intK
+       rstFfname.MoveNext
+     End If
+   Next intI
+   Next intJ
+rstFfname.Close
+Set rstFfname = Nothing
+
+End Sub
+
+
+
+
+
+