excel - 只要单元格等于相同的值，就将行加在一起

Question

我有一个问题，我正在为我的工作而努力。我收到了一个电子表格，其中 B 列中列出了公司，A 列中列出了每笔交易的总销量。有 3000 多行和大约 200 家公司。
我需要能够为 B 列中列出的每组公司添加所有 A 列。

我不知道如何在 VBA 中使用 Range.Find 来做我需要的事情。

Answer 1

使用字典总结唯一性

这是一种更有效的方法。它在另一个工作表中返回结果。

Option Explicit

Sub CreateUniqueTable()
    
    ' Source range to an array.
    
    Dim sws As Worksheet: Set sws = ThisWorkbook.Worksheets("Sheet1")
    
    Dim lRow As Long
    lRow = sws.Cells(sws.Rows.Count, "B").End(xlUp).Row
    
    Dim srg As Range: Set srg = sws.Range("A1:B" & lRow)
    Dim sData As Variant: sData = srg.Value
    
    ' Array to a dictionary (unique and sum).
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    
    Dim Key As Variant
    Dim r As Long
    
    For r = 2 To UBound(sData)
        dict(sData(r, 2)) = dict(sData(r, 2)) + sData(r, 1)
    Next r
    
    Dim rCount As Long: rCount = dict.Count + 1
    
    ' Dictionary to another array.
    
    Dim dData As Variant: ReDim dData(1 To rCount, 1 To 2)
    
    ' Write headers.
    dData(1, 1) = sData(1, 2)
    dData(1, 2) = sData(1, 1)
    Erase sData
    
    r = 1
    
    ' Write data.
    For Each Key In dict.Keys
        r = r + 1
        dData(r, 1) = Key
        dData(r, 2) = dict(Key)
    Next Key
    
    ' Array to the destination range.
    
    Dim dws As Worksheet: Set dws = ThisWorkbook.Worksheets("Sheet2")

    With dws.Range("A1").Resize(, 2)
        .Resize(rCount).Value = dData
        .Resize(dws.Rows.Count - .Row - rCount + 1).Offset(rCount).Clear
    End With
    
    ' Inform.
    
    MsgBox "Unique table created.", vbInformation
    
End Sub