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

您可能做到不VBA，使用數據透視表或SUMIFS公式。

然而，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