VBA宏用于检查公共值，然后汇总其收入

Question

Vegetable               $ Amount              Farmer
Potato                    100                 John
Potato                    200                 Jack
Carrot                    50                  Paul
Carrot                    60                  John
Sweetcorn                 100                 Paul

我想在excel中创建一个单独的工作表，它将显示每个农民的收入;我怎么能在VBA中做到这一点？ 我已经开始了，但已经陷入困境。

Sub Demo()
Dim dict1 As Object
Dim c1 As Variant, k As Variant
Dim currWS As Worksheet
Dim i As Long, lastRow As Long, tot As Long
Dim number1 As Long, number2 As Long, firstRow As Long

Set dict1 = CreateObject("Scripting.Dictionary")
Set currWS = ThisWorkbook.Sheets("farmergoods")

'get last row withh data in Column A
lastRow = currWS.Cells(Rows.count, "A").End(xlUp).Row

Answer 1

你可以使用数据透视表或SUMIFS公式在没有VBA的情况下执行此操作。

然而，使用VBA：

Option Explicit

Sub Demo()

Dim currWS As Worksheet, newWS As Worksheet
Dim Rin As Range, Rout As Range
Dim lastRow As Long
'Dim dict1 As Object ' late binding
Dim dict1 As New Scripting.Dictionary ' early binding and object creation, needs reference to Microsoft Scripting Runtime
Dim key As Variant

'=== populate the dictionary with the input data ===

'Set dict1 = CreateObject("Scripting.Dictionary") ' late binding
Set currWS = ThisWorkbook.Worksheets("farmergoods") ' set the input sheet
Set Rin = currWS.Range("A2") ' set the start of the input range
lastRow = currWS.Cells(Rows.Count, "A").End(xlUp).Row ' last row of input range (get last row with data in Column A)

Do While Rin.Row <= lastRow

    ' Column 3 ("C") is the farmer, column 2 ("B") is the $ amount
    If Not dict1.Exists(Rin(1, 3).Value) Then ' is the farmer NOT yet in the dictionary?
        dict1.Item(Rin(1, 3).Value) = Rin(1, 2).Value ' if the farmer is not yet in the dictionary, set the revenue value to the amount
    Else
        dict1.Item(Rin(1, 3).Value) = dict1.Item(Rin(1, 3).Value) + Rin(1, 2).Value  ' if the farmer is already in the dictionary, add the new amount to the previous revenue value
    End If

    Set Rin = Rin(2, 1) ' increment the input row
Loop

'=== populate the new worksheet with the dictionary items ===

Set newWS = ThisWorkbook.Worksheets.Add ' set the output sheet
newWS.Name = "farmerrevenue"

' note: I'm creating a new worksheet here, if instead the worksheet already exists use:
'Set newWS = ThisWorkbook.Worksheets("farmerrevenue")

Set Rout = newWS.Range("A1") ' set the start of the output range

Rout.Resize(, 2).Value = Array("Farmer", "$ Revenue") ' add the header first

Set Rout = Rout(2, 1) ' increment the output row

For Each key In dict1.Keys

    Rout.Resize(, 2).Value = Array(key, dict1.Item(key)) ' write the (farmer, revenue) to the output range

    Set Rout = Rout(2, 1) ' increment the output row
Next key

Set dict1 = Nothing

End Sub