Excel VBA 合并数据并删除答案

【问题标题】：Excel VBA Consolidate data and deleteExcel VBA 合并数据并删除
【发布时间】：2018-09-25 13:07:39
【问题描述】：

我有一个宏，在从另一个工作表中获取数据并对其进行格式化后，应该将 b、c 和 d 列中的数据相加，当 a 列在第一行中重复时，然后删除重复的第二行.这样做的目的是，如果两组数据在第一列中具有相同的标识符，我只会看到这些集合中的总数，而不是列表。

Range("A3:A50").Select
Set y = Selection
For x = 1 To y.Rows.Count
If y.Cells(x, 1).Value = y.Cells(x, 2).Value Then
    a = y.Cells(x + 1, 1).Value
    a = a + y.Cells(x + 1, 2).Value
    y.Cells(x + 1, 1).Value = a
    y.Cells(x + 2, 1).Value = y.Cells(x + 2, 1).Value + y.Cells(x + 2, 2).Value
    y.Cells(x + 3, 1).Value = y.Cells(x + 3, 1).Value + y.Cells(x + 3, 2).Value
End If
If y.Cells(x, 2).Value = y.Cells(x, 1).Value Then
    y.Cells(x, 2).EntireRow.Delete
End If
Next

这是那段代码，这里混合了两种尝试。在第一个 If 语句中，我尝试使用“a”作为一种方式来存储 B 列中第一个单元格的值，然后从其下方添加重复信息。另外两个正在尝试直接添加单元格值。两者似乎都不起作用，第二个 If 也不是，没有重复数据被删除，而是看起来像随机删除行。请让我知道我可以做些什么来改进这两个部分。

【问题讨论】：

好吧，这里发生了很多事情，但最让我印象深刻的是，您提到要添加 columns b, c, and d，但在您使用的范围引用 (.cells(...)) 中，您只指定到第 2 列（即 b 列）
有点不清楚您要做什么。您能否提供一个数据样本（如有必要，提供假数据）来列出初始条件，然后提供您所追求的输出样本？
您的代码不会检查第 1 行 A 列是否与第 2 行 A 列相同。y.Cells(x, 1).Value = y.Cells(x, 2).Value 检查第 1 行 A 列是否与第 1 行 B 列相同。也许 @987654325 @
此外，您正在向前推进行 - 如果您删除第 2 行，则第 3 行将成为新的第 2 行，并且不会在您的循环中进行检查，因为它已经检查了第 2 行....如果您要随时删除行，则从底行向后工作。

标签： excel vba

【解决方案1】：

另一种方法是使用临时工作表，将第一列复制到新工作表中，删除重复项，使用SUMIF 公式，然后将其全部复制回来。

Sub Test()

    Combine ThisWorkbook.Worksheets("Sheet1").Range("A1:D14")
    'Or
    'Combine Selection

End Sub


Sub Combine(Target As Range)

    Dim wrkSht As Worksheet
    Dim lLastRow As Long
    Dim x As Long

    'Add the temporary sheet & copy column 1 of the data over.
    Set wrkSht = ThisWorkbook.Worksheets.Add
    Target.Columns(1).Copy Destination:=wrkSht.Columns(1)

    With wrkSht
        'Remove the duplicates from copied data and find where the last row number.
        .Columns(1).RemoveDuplicates Columns:=1, Header:=xlNo
        lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row

        'Add a SUMIF formula to each column to calculate the totals.
        'NB: It should be possible to add the formula to all cells in one hit,
        '    but didn't have time to figure it out.
        '    The formula in column B is:
        '    =SUMIF(Sheet1!$A$1:$A$14, $A1,Sheet1!$B$1:$B$14)
        For x = 2 To 4
            .Range(.Cells(1, x), .Cells(lLastRow, x)).FormulaR1C1 = "=SUMIF('" & Target.Parent.Name & "'!" & Target.Columns(1).Address(True, True, xlR1C1) & _
                ", RC1,'" & Target.Parent.Name & "'!" & Target.Columns(x).Address(True, True, xlR1C1) & ")"
        Next x

        'Replace the formula with values,
        'clear the original table and copy the values back
        'to the original sheet.
        With .Range(.Cells(1, 1), .Cells(lLastRow, 4))
            .Copy
            .PasteSpecial xlPasteValuesAndNumberFormats
            Target.ClearContents
            .Copy Destination:=Target
        End With

    End With

    'Delete the temporary sheet.
    Application.DisplayAlerts = False
    wrkSht.Delete
    Application.DisplayAlerts = True

End Sub

编辑：
另一种方法是使用数据透视表。

创建一个引用您的数据的命名范围。
使用范围下方的公式将随着列表大小的变化而增加/减少：
=Sheet1!$A$1:INDEX(Sheet1!$D:$D,COUNTA(Sheet1!$A:$A))
插入一个 PivotTable，其中 Table/Range 设置为 =RawData（您的命名范围是 RawData）。
使用第一列作为行标签。
将其他列用作三组值。
如果原始数据发生变化，只需刷新数据透视表即可。

【讨论】：