2017-04-05 112 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 
相关问题