返回列表 上一主題 發帖

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

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

求解
請問如何用樞紐分析表做的圖片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

        靜思自在 : 地上種了菜,就不易長草;心中有善,就不易生惡。
返回列表 上一主題