2017-04-05 113 views
0

我有一個Excel 3列:VB宏組由一個柱和總和基於行的值上的另一列

date,  code, sales 
----------------------- 
1-1-2016, A, 10 

1-1-2016, B, 20 

1-1-2016, C, 30 

1-1-2016, D, 40 

1-2-2016, A, 50 

1-2-2016, B, 60 

1-2-2016, C, 70 

1-2-2016, D, 80 
----------------------- 

因此,代碼A,B,C,d爲重複多個日期。以上只是一個例子。

對於每一天,我需要爲A和C的銷售添加爲一行。而B和D的銷售又是另一排。

所以我的輸出應該是這樣的:

1-1-2016,AC,40 

1-1-2016,BD,60 

1-2-2016,AC,120 

1-2-2016,BD,140 

我如何創建一個VB宏來做到這一點?

+0

如何你試過嗎? –

回答

0

您可以嘗試類似下面並調整它根據自己的需要。

Sub SummarizeData() 
Dim sws As Worksheet, dws As Worksheet 
Dim x, y, dict, it 
Dim i As Long 

Application.ScreenUpdating = False 

Set sws = Sheets("Sheet1") 
On Error Resume Next 
Set dws = Sheets("Summary") 
dws.Cells.Clear 

If dws Is Nothing Then 
    Sheets.Add(after:=sws).Name = "Summary" 
    Set dws = ActiveSheet 
End If 

sws.Range("A1:C1").Copy dws.Range("A1") 
x = sws.Range("A1").CurrentRegion.Value 

Set dict = CreateObject("Scripting.Dictionary") 

For i = 2 To UBound(x, 1) 
    If x(i, 2) = "A" Or x(i, 2) = "C" Then 
     If Not dict.exists(x(i, 1) & ";AC") Then 
      dict.Item(x(i, 1) & ";AC") = x(i, 3) 
     Else 
      dict.Item(x(i, 1) & ";AC") = dict.Item(x(i, 1) & ";AC") + x(i, 3) 
     End If 
    ElseIf x(i, 2) = "B" Or x(i, 2) = "D" Then 
     If Not dict.exists(x(i, 1) & ";BD") Then 
      dict.Item(x(i, 1) & ";BD") = x(i, 3) 
     Else 
      dict.Item(x(i, 1) & ";BD") = dict.Item(x(i, 1) & ";BD") + x(i, 3) 
     End If 
    End If 
Next i 
ReDim y(1 To dict.Count, 1 To 3) 

i = 1 

For Each it In dict.keys 
    y(i, 1) = Split(it, ";")(0) 
    y(i, 2) = Split(it, ";")(1) 
    y(i, 3) = dict.Item(it) 
    i = i + 1 
Next it 

dws.Range("A2").Resize(UBound(y, 1), 3).Value = y 
dws.UsedRange.Columns.AutoFit 
Application.ScreenUpdating = True 
End Sub 
相關問題