Question

下面是我的源表

    Name              Sales
---------------------------------
    Thomas             100
    Jay                200
    Thomas             100
    Mathew              50

我需要的输出如下

    Name              Sales
---------------------------------
    Thomas             200
    Jay                200
    Mathew              50

基本上，我有2列可以重复的列，我需要根据第一列汇总第二列。

我拥有的当前代码如下。它的工作完全正常。要运行4500条记录，大约需要45秒。我想知道是否有更有效的方法来执行此操作……这似乎是一个微不足道的要求。

'Combine duplicate rows and sum values

Dim Rng As Range
Dim LngRow As Long, i As Long

LngLastRow = lRow 'The last row is calculated somewhere above...

'Initializing the first row
i = 1

'Looping until blank cell is encountered in first column
While Not Cells(i, 1).Value = ""

    'Initializing range object
    Set Rng = Cells(i, 1)

    'Looping from last row to specified first row
    For LngRow = LngLastRow To (i + 1) Step -1

        'Checking whether value in the cell is equal to specified cell
        If Cells(LngRow, 1).Value = Rng.Value Then
            Rng.Offset(0, 1).Value = Rng.Offset(0, 1).Value + Cells(LngRow, 2).Value
            Rows(LngRow).Delete
        End If

    Next LngRow

    i = i + 1

Wend

请注意，这是较大的excel应用程序的一部分，因此，我绝对需要Excel VBA中的解决方案。

Answer 1

您在这里：

model function

要了解有关字典（以及更多内容）的所有信息，请检查this

Answer 2

数据以 A 和 B 列为单位，例如：

运行此短宏：

Sub KopyII()
    Dim cell As Range, N As Long

    Columns("A:A").Copy Range("C1")
    ActiveSheet.Range("C:C").RemoveDuplicates Columns:=1, Header:=xlNo
    N = Cells(Rows.Count, "C").End(xlUp).Row

    Range("B1").Copy Range("D1")

    Range("D2:D" & N).Formula = "=SUMPRODUCT(--(A:A= C2),(B:B))"
End Sub

会在 C 和 D 列中生成此代码：

注意：

这依赖于Excel的内置RemoveDuplicates功能。

EDIT＃1：

正如chris neilsen指出的那样，该函数的评估应该更快一些：

Sub KopyIII()
    Dim cell As Range, N As Long, A As Range, C As Range
    Set A = Range("A:A")
    Set C = Range("C:C")

    A.Copy C
    C.RemoveDuplicates Columns:=1, Header:=xlNo
    N = Cells(Rows.Count, "C").End(xlUp).Row

    Range("B1").Copy Range("D1")  ' the header

    Range("D2:D" & N).Formula = "=SUMIFS(B:B,A:A,C2)"
End Sub

需要帮助来优化汇总重复项的Excel VBA代码

2 个答案: