时间戳

首页 > 解决方案 > Excel VBA 合并数据并删除

excel - Excel VBA 合并数据并删除

问题描述

我有一个宏，在从另一个工作表中获取数据并对其进行格式化后，应该将 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 也不是，没有重复数据被删除，而是看起来像是随机删除行。请让我知道我可以做些什么来改进这两个部分。

标签： excelvba

解决方案

另一种方法是使用临时工作表，将第一列复制到新工作表中，删除重复项，使用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))
  • 插入一个数据透视表，其中表/范围设置为=RawData（您的命名范围是RawData）。
  • 使用第一列作为Row Labels。

  • 将其他列用作三组Values。

  • 如果原始数据发生变化，只需刷新数据透视表。

推荐阅读