Question

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

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列中的方法，然后从其下面添加重复信息。另外两个正在尝试直接添加单元格值。两者似乎均不起作用，第二个（如果两者均不）则不会删除任何重复数据，而是看起来它是随机删除行。请让我知道我可以做什么来改善这两个部分。

Answer 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))
插入数据透视表，将表/范围设置为=RawData（其中命名范围为RawData）。
将第一列用作行标签。
将其他列用作三组 Values 。
如果原始数据发生变化，只需刷新数据透视表即可。

Excel VBA合并数据并删除

1 个答案: