返回列表 上一主題 發帖

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

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

求解
請問如何用樞紐分析表做的圖片1的效果
效果如下
PART-NO                       02F-09F               10F-17F
E1011-900                        344                     344
F211                                   6880                   5505

原因
FRAME-NO         QTY       02F-09F                                     10F-17F
WS100                   1             111        (1*111)=111               296              (1*296)=296
WS101                   1             18          (1*18)=18                     48                (1*18)=48
WS102                   1             111        (1*111)=111
WS103                   1             18          (1*18)=18
WS104                   1             74          (1*74)=74
WS105                   1             12          (1*12)=12
TOTAL:                                                         344                                                344

原因
FRAME-NO         QTY       02F-09F                                               10F-17F
WS100                   16             111       (16*111)=1776                  296      (16*296)=4736
WS101                   16             18         (16*18)=288                         48       (16*48)=769
WS102                   16             111       (16*111)=1776
WS103                   16             18          (16*18)=288
WS104                   16             74          (16*74)=1184
WS105                   16             12          (16*12)=192
WS106                   16             74          (16*74)=1184
WS107                   16             12          (16*12)=192
TOTAL                                                        6880                                 5505
1.jpg

1.zip (19.99 KB)

求解
請問如何用樞紐分析表做的圖片1的效果
效果如下
PART-NO                       02F-09F           ...
198188 發表於 2023-11-4 16:34


不懂得如何計算

2.rar (69.51 KB)

TOP

本帖最後由 198188 於 2023-11-5 09:59 編輯
不懂得如何計算
198188 發表於 2023-11-4 21:13


求簡法,加上不同語言的excel, 下面中文語法,在其他語言版本的excel會出現error, 有無解決方式?


    Sub Summary()
    Sheets.Add After:=ActiveSheet
    Sheets("工作表1").Select
    Sheets("工作表1").Name = "Summary"
    Range("D30").Select
    Sheets("Part List").Select
    Columns("A:A").Select
    Selection.Copy
    Sheets("Summary").Select
    Range("K1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Part List").Select
    Columns("G:G").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Summary").Select
    Range("L1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Part List").Select
    Columns("C:C").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Summary").Select
    Range("M1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Frame List").Select
    Range("B1:F1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Summary").Select
    Range("N1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("K:R").Select
    Columns("K:R").EntireColumn.AutoFit
    Range("N2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = _
        "=IFERROR(VLOOKUP(RC[-2],'Frame List'!C[-13]:C[-8],2,0),0)*M2"
    Range("O2").Select
    ActiveCell.FormulaR1C1 = _
        "=IFERROR(VLOOKUP(RC[-3],'Frame List'!C[-14]:C[-9],3,0),0)*M2"
    Range("P2").Select
    ActiveCell.FormulaR1C1 = _
        "=IFERROR(VLOOKUP(RC[-4],'Frame List'!C[-15]:C[-10],4,0),0)*M2"
    Range("Q2").Select
    ActiveCell.FormulaR1C1 = _
        "=IFERROR(VLOOKUP(RC[-5],'Frame List'!C[-16]:C[-11],5,0),0)*M2"
    Range("R2").Select
    ActiveCell.FormulaR1C1 = _
        "=IFERROR(VLOOKUP(RC[-6],'Frame List'!C[-17]:C[-12],6,0),0)*M2"
    Range("N2:R2").Select
    Selection.AutoFill Destination:=Range("N2:R306")
    Range("N2:R306").Select
    Columns("K:R").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Application.CutCopyMode = False
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Summary!R1C11:R1048576C18", Version:=6).CreatePivotTable TableDestination _
        :="Summary!R1C1", TableName:="枷ク猂1", DefaultVersion:=6
    Sheets("Summary").Select
    Cells(1, 1).Select
    With ActiveSheet.PivotTables("枷ク猂1").PivotFields("PART-NO")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("樞紐分析表1").AddDataField ActiveSheet.PivotTables("樞紐分析表1" _
        ).PivotFields("02F-09F"), "加總 - 02F-09F", xlSum
    ActiveSheet.PivotTables("樞紐分析表1").AddDataField ActiveSheet.PivotTables("樞紐分析表1" _
        ).PivotFields("10F-17F"), "加總 - 10F-17F", xlSum
    ActiveSheet.PivotTables("樞紐分析表1").AddDataField ActiveSheet.PivotTables("樞紐分析表1" _
        ).PivotFields("18F-25F"), "加總- 18F-25F", xlSum
    ActiveSheet.PivotTables("樞紐分析表1").AddDataField ActiveSheet.PivotTables("樞紐分析表1" _
        ).PivotFields("26F-33F"), "加總 - 26F-33F", xlSum
    ActiveSheet.PivotTables("樞紐分析表1").AddDataField ActiveSheet.PivotTables("樞紐分析表1" _
        ).PivotFields("34F-42F"), "加總 - 34F-42F", xlSum
    ActiveWorkbook.ShowPivotTableFieldList = False
    Columns("K:R").Select
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    ActiveWindow.ScrollColumn = 1
    Range("A1").Select
End Sub

数量源数据透视表.rar (45.8 KB)

TOP

本帖最後由 Andy2483 於 2023-11-7 08:07 編輯

回復 3# 198188


    謝謝論壇,謝謝前輩發表此主題與範例
後學藉此帖練習陣列與字典,學習方案如下,請前輩參考
20231107_2.zip (33.51 KB)

執行前:
20231106_1.jpg
2023-11-6 14:30


執行結果:
20231106_2.jpg
2023-11-6 14:30


Option Explicit
Sub TEST()
Dim Arr, Brr, Crr, Z, i&, j%, R&, c%, N&, T$, T2$, T3$, T4$
Set Z = CreateObject("Scripting.Dictionary")
c = Sheets(1).[IV1].End(xlToLeft).Column
Brr = Range(Sheets(1).Cells(1, c), Sheets(1).[A65536].End(3))
Crr = Range(Sheets(2).[G1], Sheets(2).[A65536].End(3))
ReDim Arr(1 To UBound(Crr), 1 To c)
For i = 2 To UBound(Brr): Z(Trim(Brr(i, 1)) & "/r") = i: Next
For i = 2 To UBound(Crr)
   R = Z(Crr(i, 1))
   If R = 0 Then N = N + 1: R = N: Arr(N, 1) = Crr(i, 1): Z(Crr(i, 1)) = R
   T = Trim(Crr(i, 7))
   For j = 2 To UBound(Brr, 2)
      If Z(T & "/r") = "" Then Arr(R, j) = 0 Else Arr(R, j) = Arr(R, j) + Brr(Z(T & "/r"), j)
   Next
Next
If R = 0 Then Exit Sub
With Sheets(3)
   T2 = .[A65536].End(3): T3 = Left(.[B1], 5)
   T4 = .[A65536].End(3)(0): .UsedRange.Clear
   With .[A2].Resize(R, UBound(Arr, 2))
      .Value = Arr: .Sort KEY1:=.Item(1), Order1:=1, Header:=2
   End With
   For j = 1 To c: Brr(1, j) = T3 & Brr(1, j): Next
   .[A1].Resize(1, c) = Brr: .[A1] = Sheets(2).[A1]
   .Cells(R + 2, 1) = T4: .Cells(R + 3, 1) = T2
   .Cells(R + 3, 2).Resize(1, c - 1).Value = "=SUM(B2:B" & R + 1 & ")"
   Union(.[1:1], .Rows(R + 3)).Font.Bold = True: Application.Goto .[A1]
End With
Set Z = Nothing: Erase Brr, Crr, Arr
End Sub

20231106_1.zip (34.6 KB)

Header:=1 需改為 Header:=2

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

本帖最後由 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

回復  198188


    謝謝論壇,謝謝前輩發表此主題與範例
後學藉此帖練習陣列與字典,學習方案如下,請前 ...
Andy2483 發表於 2023-11-6 14:31



   感謝前輩指點,不過數量超過1的貨的答案沒有乘以數量。
舉例
在sheet "Part List" Part-No: EG039-900; Frame-No: WS100; Qty: 2
在sheet "Frame List Frame-No: WS100: 02F-09F: 111
02F-09F 出來的答案應該是2*111=222

20231107_2.zip (62.56 KB)

TOP

回復 6# 198188


   
If Z(T & "/r") = "" Then Arr(R, j) = 0 Else Arr(R, j) = Arr(R, j) + Brr(Z(T & "/r"), j) * VaL(Crr(i, 3))
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

謝謝論壇,謝謝各位前輩
後學訂正複習心得註解如下,請各位前輩指教

Option Explicit
Sub TEST()
Dim Arr, Brr, Crr, Z, i&, R&, N&, j%, c%, T$, T2$, T3$, T4$
'↑宣告變數:(Arr,Brr,Crr,Z)是通用型變數,(i,R,N)是長整數變數,(j,c)是短整數變數,
'(T,T2,T3,T4)是字串變數

Set Z = CreateObject("Scripting.Dictionary")
'↑令Z這通用型變數是 字典
c = Sheets(1).[IV1].End(xlToLeft).Column
'↑令c這短整數變數是 第1表第1列最右側有內容的索引欄號
Brr = Range(Sheets(1).Cells(1, c), Sheets(1).[A65536].End(3))
'↑令Brr這通用型變數是 二維陣列,以範圍儲存格值帶入:
'第1表c變數欄第1列儲存格到 第1表A欄最後有內容儲存格

Crr = Range(Sheets(2).[G1], Sheets(2).[A65536].End(3))
'↑令Crr這通用型變數是 二維陣列,以範圍儲存格值帶入:
'第2表[G1]儲存格到 第2表A欄最後有內容儲存格

ReDim Arr(1 To UBound(Crr), 1 To c)
'↑宣告Arr這通用型變數是 二維空陣列,縱向範圍索引號1到Crr陣列縱向最大索引列號,
'橫向範圍1到 c變數 索引欄號

For i = 2 To UBound(Brr): Z(Trim(Brr(i, 1)) & "/r") = i: Next
'↑設順迴圈!i從2 到Brr陣列縱向最大索引列號
'↑令i迴圈列1欄Brr陣列值去除頭尾空字元,連接"/r"組成的字串當key,
'item是i變數,納入Z字典中

For i = 2 To UBound(Crr)
'↑設順迴圈!i從2 到Crr陣列縱向最大索引列號
   R = Z(Trim(Crr(i, 1)))
   '↑令R這長整數變數是以 i迴圈列1欄Crr陣列值去除頭尾空字元 字串,
   '查Z字典回傳Item值

   If R = 0 Then N = N + 1: R = N: Arr(N, 1) = Crr(i, 1): Z(Trim(Crr(i, 1))) = R
   '↑如果R變數是0!就令N這長整數累加1,令R變數同N變數值,
   '令N變數列1欄Arr陣列值是 i迴圈列1欄Crr陣列值
   '令i迴圈列1欄Crr陣列值去除頭尾空字元 字串當key,R變數值當item 納入Z字典裡

   T = Trim(Crr(i, 7))
   '↑令T這字串變數是 i迴圈列7欄Crr陣列值去除頭尾空字元 字串
   For j = 2 To UBound(Brr, 2)
   '↑設順迴圈!j從2 到Brr陣列橫向最大索引欄號
      If Z(T & "/r") = "" Then Arr(R, j) = 0 Else Arr(R, j) = Arr(R, j) + Brr(Z(T & "/r"), j) * Val(Crr(i, 3))
      '↑如果以T變數連接"/r"組成的新字串查Z字典回傳item是空字元,
      '就令R變數列j變數欄Arr陣列值是0
      '否則就令R變數列j變數欄Arr陣列值是 累加(Brr陣列值* i迴圈列3欄Crr陣列值)
      'Brr陣列值:(T變數連接"/r"組成的新字串查Z字典回傳item)列,j變數欄Brr陣列值

   Next
Next
If R = 0 Then MsgBox "沒有符合的資料": Exit Sub
'↑如果R變數是0!就跳出提視窗~~~,結束程式執行
With Sheets(3)
'↑以下是關於第3表的程序
   T2 = .[A65536].End(3): T3 = Left(.[B1], 5)
   '↑令T2這字串變數是A欄最後有內容儲存格字串
   '↑令T3這字串變數是[B1]儲存格左側5個字元

   T4 = .[A65536].End(3)(0): .UsedRange.Clear
   '↑令T4這字串變數是 A欄最後有內容儲存格前一格字串
   With .[A2].Resize(R, UBound(Arr, 2))
   '↑以下是關於第3表[A2]擴展向下R變數列,擴展向右(Arr橫向最大索引欄號)欄,
   '關於此範圍儲存格的程序

      .Value = Arr: .Sort KEY1:=.Item(1), Order1:=1, Header:=2
      '↑令此範圍儲存格值以Arr陣列帶入
      '↑令此範圍儲存格做第1欄為基準的無標題漸增排序

   End With
   For j = 1 To c: Brr(1, j) = T3 & Brr(1, j): Next
   '↑設順迴圈!j從1到c變數
   '令第1列j迴圈欄Brr陣列值是 T3變數連接自身陣列值組合成的新字串

   .[A1].Resize(1, c) = Brr: .[A1] = Sheets(2).[A1]
   '↑令第3表[A1]擴展向右c變數欄範圍儲存格值 以Brr陣列值帶入
   '↑令第3表[A1]儲存格值同 第2表[A1]儲存格值

   .Cells(R + 2, 1) = T4: .Cells(R + 3, 1) = T2
   '↑令第3表A欄(R變數+2)列儲存格是 T2變數
   .Cells(R + 3, 2).Resize(1, c - 1).Value = "=SUM(B2:B" & R + 1 & ")"
   '↑令第3表B欄(R變數+3)列儲存格擴展向右(c變數-1)欄範圍儲存格值是公式
   '公式:SUM()加總 B2到B欄(R變數+1)列
   'C~F欄公式會自動變化

   Union(.[1:1], .Rows(R + 3)).Font.Bold = True: Application.Goto .[A1]
   '↑令第1列與最後列儲存格字體為粗體
   '↑令游標跳到第3表[A1]儲存格

End With
Set Z = Nothing: Erase Brr, Crr, Arr
'↑令釋放變數
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

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

回復 6# 198188
3.zip (87.47 KB)
VNXzWXp.png
2023-11-7 10:49

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

謝謝論壇,謝謝各位前輩
後學訂正複習心得註解如下,請各位前輩指教

Option Explicit
Sub TEST()
Dim A ...
Andy2483 發表於 2023-11-7 10:16



   謝謝您的詳盡注解

TOP

        靜思自在 : 一個人的快樂.不是因為他擁有得多,而是因為他計較得少。
返回列表 上一主題