查找重复项，求和并在新列 Excel VBA 中发布总和答案

【问题标题】：Find duplicates, sum corresponsive and post the sums in a new column Excel VBA查找重复项，求和并在新列 Excel VBA 中发布总和
【发布时间】：2014-02-19 14:24:11
【问题描述】：

我是新来的，但我希望无论如何我都能得到我的问题的答案我尝试搜索我的问题，但如果已经有类似的帖子，我找不到一个帖子，非常抱歉。

我有几个文件，其中包含 A 到 T 列中的多个列表。我需要在列中查找重复项并将不同列中的对应单元格相加，然后将结果添加到新列中。我已经有一个代码可以满足我的需要，但不完全是我想要的。问题是这段代码将结果写在与重复项的第一个（名称）相同的行中。所以如果我的列表是这样的，它会写出如下所示的结果：

A B C
a 5 10
a 2 
a 3
b 2 6
b 3
b 1
c 4 7
c 1
c 2

我希望它将结果写入第 1,2 和 3 行，而不是在“右”行之前显示空白。我还想在结果旁边保留类型的名称。像这样：

Name Results
a 10
b 6
c 7

Sub sample()

Dim lastRow As Integer, num As Integer, i As Integer
lastRow = Range("C65000").End(xlUp).Row


For i = 14 To lastRow
num = WorksheetFunction.Match(Cells(i, 3), Range("C1:C" & lastRow), 0)
If i = num Then
Cells(i, 25) = WorksheetFunction.SumIf(Range("C1:C" & lastRow), Cells(i, 3), Range("J1:J" & lastRow))
Cells(i, 25).Interior.Color = vbGreen
Else
Cells(i, 3).Interior.Color = vbYellow
End If
Next i

End Sub

我已经尝试过修改代码，但我只是不知道如何制作它，所以我得到了我需要的东西..：/

感谢您的帮助

代码的另一个问题是，如果有一个空白行（这种情况经常发生），代码只适用于行，直到空白然后退出并告诉我有问题。

【问题讨论】：

标签： excel sum duplicates vba

【解决方案1】：

试试这个，对我有用。

Application.ScreenUpdating = False
Range("c:c").Clear
For i = 1 To Sheet1.UsedRange.Rows.Count
    alreadythere = False
    For k = 1 To i
        If Cells(k, 1) = Cells(i, 1) Then
            alreadythere = True
            Exit For
        End If
    Next k
    If alreadythere = False Then
        Cells(i, 3) = Cells(i, 2)
      Else
        Cells(k, 3) = Cells(k, 3) + Cells(i, 2)
    End If
Next i
Application.ScreenUpdating = True

【讨论】：