Question

我有一个包含3列的Excel：

<link href="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/css/bootstrap.min.css" rel="stylesheet"/>
<script src="https://ajax.googleapis.com/ajax/libs/jquery/3.2.0/jquery.min.js"></script>
  <script src="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/js/bootstrap.min.js"></script>
<body>

<div class="container">
  <h2</h2>
  <!-- Trigger the modal with a button -->
  <button type="button" class="btn" data-toggle="modal" data-target="#myModal">Open Modal</button>

  <!-- Modal -->
  <div class="modal fade" id="myModal" role="dialog">
    <div class="modal-dialog">
    
      <!-- Modal content-->
      <div class="modal-content">
        <div class="modal-header">
          <button type="button" class="close" data-dismiss="modal">&times;</button>
          <h4 class="modal-title">Modal Header</h4>
        </div>
        <div class="modal-body">
          <p>Some text in the modal.</p>
        </div>
        <div class="modal-footer">
          <button type="button" class="btn btn-default" data-dismiss="modal">Close</button>
        </div>
      </div>
      
    </div>
  </div>
  
</div>

</body>

因此代码A，B，C，D重复多个日期。以上只是一个样本。

对于每个日期，我需要将A和C的销售额添加为一行。而B和D的销售又是另一行。

所以我的输出应该是这样的：

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
-----------------------

如何创建VB宏来完成此任务？

Answer 1

您可以尝试下面的内容并根据需要进行调整。

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

VB宏按一列分组，并根据另一列的行值求和

1 个答案: