starbox520

如圖示有A-E欄

判斷A.B.C.D欄如果為一致

就為一組資料

再去做E欄的加總  如附圖   

原本想用錄製巨集

但是假如資料一多

怕會有很多地方lose掉

還請問各位行家該如何著手這個問題><"

下載 (47.1 KB)

2016-10-5 15:01

下載 (10.72 KB)

2016-10-5 15:02

下載 (13.73 KB)

2016-10-5 15:02

加總.zip (16.9 KB)

下載次數: 8

2016-10-5 15:02

准提部林

Sub TEST()
Dim Arr, Brr, xD, Dn&, T$, N&, i&, j%
Arr = Range([A1], Cells(Rows.Count, 1).End(xlUp)(1, 5))
Set xD = CreateObject("Scripting.Dictionary")
ReDim Brr(1 To UBound(Arr), 1 To 5)
For i = 2 To UBound(Arr)
　　For j = 1 To 4: T = T & "/" & Arr(i, j): Next
　　　　Dn = xD(T)
　　　　If Dn = 0 Then
　　　　　N = N + 1: Dn = N: xD(T) = N
　　　　　For j = 1 To 4: Brr(Dn, j) = Arr(i, j): Next
　　　　End If
　　　　Brr(Dn, 5) = Brr(Dn, 5) + Val(Arr(i, 5)): T = ""
Next i
If N > 0 Then [H2].Resize(N, 5) = Brr
End Sub

Xl0000035.rar (16.73 KB)

下載次數: 11

2016-10-5 21:00

　

starbox520

回復 2# 准提部林


    回版大
    對耶這是我想要的結果
    可以再麻煩版大解說一下程式碼的部分嗎
    我想讓自己去嘗試做變動

stillfish00

回復 1# starbox520
樞紐分析表細部調整後也能達成

1. Sub test()
   
2.     Dim rngData As Range: Set rngData = Sheets("工作表1").Range("A1:E33")
   
3.     Dim arKeyFields: arKeyFields = Array("CR", "LN", "PG", "BE")
   
4.     Dim sumField: sumField = "QQ"
   
5. 
   
6.     Dim pvt As PivotTable, i, x
   
7.     With Sheets.Add
   
8.         Set pvt = ActiveWorkbook.PivotCaches.Create( _
   
9.                 SourceType:=xlDatabase, _
   
10.                 SourceData:=rngData, _
    
11.                 Version:=xlPivotTableVersion14 _
    
12.             ).CreatePivotTable(TableDestination:=.[A1])
    
13.     End With
    
14.     With pvt
    
15.         .InGridDropZones = False
    
16.         .ShowDrillIndicators = False
    
17.         .DisplayFieldCaptions = True
    
18.         .RowGrand = False
    
19.         .ColumnGrand = False
    
20.         .RowAxisLayout xlTabularRow
    
21.         i = 1
    
22.         For Each x In arKeyFields
    
23.             .PivotFields(x).Orientation = xlRowField
    
24.             .PivotFields(x).RepeatLabels = True
    
25.             .PivotFields(x).Subtotals(1) = False
    
26.             .PivotFields(x).Position = i
    
27.         Next
    
28.         .AddDataField .PivotFields(sumField), "加總 - " & sumField, xlSum
    
29.     End With
    
30. End Sub

複製代碼

下載 (74.1 KB)

2016-10-6 11:34

starbox520

回復 2# 准提部林

不好意思想再修正一下

如果資料型態改成工作表2

一樣想跑出工作表1的樣子呢

下載 (18.08 KB)

2016-10-7 00:28

下載 (7.85 KB)

2016-10-7 00:28

[attach]

starbox520

回復 4# stillfish00


    回大大因為我沒用過樞紐分析表
    剛剛試了好幾回都弄不出來
    如果用此功能
    資料型態改成附圖這樣
    一樣能夠跑出我想要的資料嗎
   

下載 (18.08 KB)

2016-10-7 00:34

下載 (7.85 KB)

2016-10-7 00:34

Xl0000040.rar (27.6 KB)

下載次數: 3

2016-10-7 00:34

stillfish00

回復 6# starbox520
4# 漏了 i=i+1

你再改第一行的資料範圍就好了
Set rngData = Sheets("工作表2").Range("A1:G33")

starbox520

回復 7# stillfish00


    回S大
    方便放檔案給我看嗎
    我加上去後一直出現錯誤><"

准提部林

回復 5# starbox520


Xl0000160_v1.rar (21.03 KB)

下載次數: 9

2016-10-7 17:48

starbox520

回復 9# 准提部林


    回大大
   有沒有辦法在按完鈕後(C,E)欄都不要呢
    只跑出像這樣就好

下載 (7.97 KB)

2016-10-7 19:12