返回列表 上一主題 發帖

樞紐分析表-多重表格匯總

本帖最後由 singo1232001 於 2023-11-7 00:01 編輯

回復 3# 198188


    Sub test()
Set CN = CreateObject("adodb.connection"): V = Application.Version
If V >= 12 Then V = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;"
If V < 12 Then V = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;"
CN.Open V & "Data Source=" & ThisWorkbook.FullName
Set s = Sheets("工作表2"): s.[A:Z].ClearContents
For Each Z In Sheets
If Z.Name Like "*窗玉*量*" Then Set s0 = Z : ar = s0.[B1:F1]
If Z.Name Like "*窗玉*清*" Then Set s1 = Z
Next
For Each Z In ar: p = p & "b.[" & Z & "], ": Next : p = "a.[PART-NO], " & Left(p, Len(p) - 2)
For Each Z In ar: p1 = p1 & "sum([" & Z & "]) as '" & Z & "', ": Next :p1 = Left(p1, Len(p1) - 2)
For Each Z In ar
p2 = p2 & "IIF([" & Z & "] IS NULL, 0, [" & Z & "]) AS [" & Z & "], "
:Next :p2 = "[FRAME-NO] as [FRAME-NO], " & Left(p2, Len(p2) - 2)
q = "select [PART-NO], " & p1 & " from ( select " & p & " from ( "
q = q & " select [PART-NO] ,[FRAME-NO] from [" & s1.Name & "$A1:G] ) as a left join ( "
q = q & " select " & p2 & " from [" & s0.Name & "$A1:F]  "
q = q & " ) as b on a.[FRAME-NO] = b.[FRAME-NO] ) group by [PART-NO] "
s.[A4].CopyFromRecordset CN.Execute(q)
s.[B3:F3] = ar: s.[A3] = "FRAME-NO"
End Sub

2.zip (88.81 KB)

TOP

本帖最後由 singo1232001 於 2023-11-7 10:50 編輯

回復 6# 198188
3.zip (87.47 KB)
Sub test2()
Set CN = CreateObject("adodb.connection"): V = Application.Version
If V >= 12 Then V = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;"
If V < 12 Then V = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;"
CN.Open V & "Data Source=" & ThisWorkbook.FullName
Set s = Sheets("工作表2"): s.[A:Z].ClearContents
For Each Z In Sheets
If Z.Name Like "*窗玉*量*" Then Set s0 = Z: ar = s0.[B1:F1]
If Z.Name Like "*窗玉*清*" Then Set s1 = Z
Next
For Each Z In ar: p = p & "b.[" & Z & "]*[QTY] as [" & Z & "] , ": Next
For Each Z In ar: p1 = p1 & "sum([" & Z & "]) as '" & Z & "', ": Next
For Each Z In ar
p2 = p2 & "IIF([" & Z & "] IS NULL, 0, [" & Z & "]) AS [" & Z & "], ": Next
p = "a.[PART-NO], " & Left(p, Len(p) - 2)
p1 = Left(p1, Len(p1) - 2)
p2 = "[FRAME-NO] as [FRAME-NO], " & Left(p2, Len(p2) - 2)

q = "select [PART-NO], " & p1 & " from ( "
q = q & " select " & p & " from ( "
q = q & " select [PART-NO] ,[FRAME-NO], [QTY] from [" & s1.Name & "$A1:G]"
q = q & " ) as a left join ( "
q = q & " select " & p2 & " from [" & s0.Name & "$A1:F]  "
q = q & " ) as b on a.[FRAME-NO] = b.[FRAME-NO] "
q = q & " ) group by [PART-NO] "
s.[A4].CopyFromRecordset CN.Execute(q)
s.[B3:F3] = ar: s.[A3] = "FRAME-NO"
End Sub



---主程序註解
Sub test()
    ' 創建一個新的ADODB連接對象
    Set CN = CreateObject("adodb.connection"): V = Application.Version
    ' 根據Excel的版本選擇合適的數據提供程序
    If V >= 12 Then V = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;"
    If V < 12 Then V = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;"
    ' 開啟連接到當前工作簿
    CN.Open V & "Data Source=" & ThisWorkbook.FullName
   
    ' 清除工作表2的A到Z列的內容
    Set s = Sheets("工作表2"): s.[A:Z].ClearContents
   
    ' 遍歷所有工作表以尋找匹配特定名稱模式的工作表
    For Each Z In Sheets
        If Z.Name Like "*窗玉*量*" Then Set s0 = Z: ar = s0.[B1:F1]
        If Z.Name Like "*窗玉*清*" Then Set s1 = Z
    Next
   
    ' 組合SQL語句中需要用到的字段列表
    For Each Z In ar: p = p & "b.[" & Z & "]*[QTY] as [" & Z & "] , ": Next
    For Each Z In ar: p1 = p1 & "sum([" & Z & "]) as '" & Z & "', ": Next
    For Each Z In ar
        p2 = p2 & "IIF([" & Z & "] IS NULL, 0, [" & Z & "]) AS [" & Z & "], "
    Next
   
    ' 去除最後一個多餘的逗號
    p = "a.[PART-NO], " & Left(p, Len(p) - 2)
    p1 = Left(p1, Len(p1) - 2)
    p2 = "[FRAME-NO] as [FRAME-NO], " & Left(p2, Len(p2) - 2)
   
    ' 構建完整的SQL查詢語句
    q = "select [PART-NO], " & p1 & " from (  select " & p & " from ( "
    q = q & " select [PART-NO] ,[FRAME-NO], [QTY] from [" & s1.Name & "$A1:G]  ) as a left join ( "
    q = q & " select " & p2 & " from [" & s0.Name & "$A1:F]  "
    q = q & " ) as b on a.[FRAME-NO] = b.[FRAME-NO] ) group by [PART-NO] "
   
    ' 執行SQL查詢並將結果複製到工作表2的A4單元格
    s.[A4].CopyFromRecordset CN.Execute(q)
   
    ' 在工作表上設置字段表頭
    s.[B3:F3] = ar
    s.[A3] = "FRAME-NO"
End Sub


---SQL語法註解
-- 選擇部件編號和對應數量範圍的總和
select [PART-NO],
       sum([02F-09F]) as '02F-09F',
       sum([10F-17F]) as '10F-17F',
       sum([18F-25F]) as '18F-25F',
       sum([26F-33F]) as '26F-33F',
       sum([34F-42F]) as '34F-42F'
-- 從以下子查詢的結果中進行選擇
from (  
    -- 選擇部件編號和經過數量加權後的各數量範圍
    select a.[PART-NO],
           b.[02F-09F]*[QTY] as [02F-09F],
           b.[10F-17F]*[QTY] as [10F-17F],
           b.[18F-25F]*[QTY] as [18F-25F],
           b.[26F-33F]*[QTY] as [26F-33F],
           b.[34F-42F]*[QTY] as [34F-42F]  
    -- 從一個表格中選擇部件編號、框架編號和數量
    from ( select [PART-NO], [FRAME-NO], [QTY]
           from [窗玉???清單$A1:G] ) as a
    -- 左側連接一個表格,該表格為各數量範圍提供了空值的檢查和預處理
    left join (  
        select [FRAME-NO],
               IIF([02F-09F] IS NULL, 0, [02F-09F]) AS [02F-09F],
               IIF([10F-17F] IS NULL, 0, [10F-17F]) AS [10F-17F],
               IIF([18F-25F] IS NULL, 0, [18F-25F]) AS [18F-25F],
               IIF([26F-33F] IS NULL, 0, [26F-33F]) AS [26F-33F],
               IIF([34F-42F] IS NULL, 0, [34F-42F]) AS [34F-42F]
        from [窗玉分批數量$A1:F]   
    ) as b
    -- 連接條件是兩個子查詢的框架編號相同
    on a.[FRAME-NO] = b.[FRAME-NO]  
)
-- 最後按部件編號進行分組,對每組進行統計
group by [PART-NO]


這個查詢的目的是為了合計每個部件編號(PART-NO)在不同的數量範圍(如02F-09F, 10F-17F 等)內的數量,並將結果作為新的列顯示。這是通過對兩個表進行左連接並在連接之後對數量進行乘法操作來實現的,如果原表中的數據為空(NULL),則該數量範圍的值將被視為 0。最後,查詢按照部件編號對這些加權後的數量進行了分組和求和。


---SQL改VBA註解
' 初始化查詢字符串 q
q = "select [PART-NO], " & p1 & " from (  select " & p & " from ( "
' 此處 q 開始構建一個嵌套查詢
' 首先,選擇 PART-NO 和由 p1 變量表示的一系列使用聚合函數 sum() 的列,這些列名由工作表 s0 的 B1:F1 單元格決定
' p1 中的列是由之前循環構建的,包含了將每個列的總和重新命名為該列名的語句

q = q & " select [PART-NO], [FRAME-NO], [QTY] from [" & s1.Name & "$A1:G]  ) as a left join ( "
' 接下來添加了從 s1 工作表選擇 PART-NO, FRAME-NO, QTY 這三列的子查詢
' 此子查詢被賦予別名 a,並計劃與別名為 b 的另一個子查詢進行左連接

q = q & " select " & p2 & " from [" & s0.Name & "$A1:F]  "
' 這裡添加了第二個子查詢,這次是從 s0 工作表中選擇由 p2 變量表示的列
' p2 包含了一系列的 IIF 語句,用來檢查 s0 工作表中的列是否為 NULL,如果為 NULL 則替換為 0,否則保留原值
' 這些列也被重新命名為原來的列名

q = q & " ) as b on a.[FRAME-NO] = b.[FRAME-NO] ) group by [PART-NO] "
' 最後,將兩個子查詢通過 FRAME-NO 進行左連接,並在外層查詢中按 PART-NO 進行分組
' 這意味著我們將得到按 PART-NO 分組的每個 PART-NO 的所有列的總和,其中來自 s0 的數據將以 0 替換空值

' 將整個查詢賦值給 q 變量
s.[A4].CopyFromRecordset CN.Execute(q)
' 執行上述 SQL 查詢,並將結果從記錄集複製到工作表 s 中 A4 單元格開始的位置

TOP

        靜思自在 : 【時間如鑽石】時間對一個有智慧的人而言,就如鑽石般珍貴;但對愚人來說,卻像是一把泥土,一點價值也沒有。
返回列表 上一主題