合并重复行并总结下一列vba

Question

如何在cloumn中找到重复项并将它们合并为单个单元格     添加它们的相邻列并将它们显示为单个单元格值？     简而言之，我如何将表1转换为表2格式？    表1

|---------------------|------------------|
|      Heading 1      |     Heading 2    |
|---------------------|------------------|
|          12         |         34       |
|---------------------|------------------|
|---------------------|------------------|
|          12         |         54       |
|---------------------|------------------|
|---------------------|------------------|
|          13         |         43       |
|---------------------|------------------|

表2

|---------------------|------------------|
|      Heading 1      |     Heading 2    |
|---------------------|------------------|
|          12         |         88       |
|---------------------|------------------|
|---------------------|------------------|
|          13         |         43       |
|---------------------|------------------|

以下是我尝试过的代码。它只是将重复值标记为重复，我无法总结这些值并在前一个单元格中显示它们

Sub sbFindDuplicatesInColumn()
Dim lastRow As Long
Dim matchFoundIndex As Long
Dim iCntr As Long
lastRow = Range("A65000").End(xlUp).Row
For iCntr = 1 To lastRow
If Cells(iCntr, 1) <> "" Then
matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range("A1:A" & 
lastRow), 0)
If iCntr <> matchFoundIndex Then
Cells(iCntr, 2) = "Duplicate"
End If
End If
Next
End Sub

Answer 1

这使用C列作为辅助列，其中填充了Sumif公式以汇总与A列值匹配的所有值，然后删除B列并将C列移到其位置，然后删除重复项以获得所需的结果

以下内容可以按照您的意愿进行：

Sub foo()
    LastRow = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row 'find the last row with data
    Sheet1.Cells(1, 3).Value = "Heading 2" 'add heading to column C
        For i = 2 To LastRow
            Sheet1.Cells(i, 3).Value = "=SUMIF(C[-2],RC[-2],C[-1])" 'enter formula to sum values of column B into column C
        Next i
    Sheet1.Range("C:C").Copy 'Copy values of column C
    Sheet1.Range("C:C").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'paste as values on column C
    Range("B:B").Delete Shift:=xlToLeft 'Delete Column B and shift Column C to the left
    Application.CutCopyMode = False
    Sheet1.Range("$A$1:$B$" & LastRow).RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes ' Remove duplicates
End Sub

Answer 2

使用数据透视表：

。

。

或者，与VBA制作相同的数据透视表：

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="Sheet1!R1C1:R4C2", Version:=6).CreatePivotTable TableDestination:="Sheet1!R1C4", TableName:="PivotTable1"
With ActiveSheet.PivotTables("PivotTable1")
    .PivotFields("Heading 1").Orientation = xlRowField
    .AddDataField ActiveSheet.PivotTables("PivotTable1").PivotFields("Heading 2"), "Sum of Heading 2", xlSum
End With

☃