如何在不同情况下(Excel)中删除Excel中的重复项? [英] How to delete duplicates in excel in different situations (VBA)?

问题描述

我需要将相应的值求和到正确的列中，而且还要删除重复项.这是交易:

I need to sum corresponding values in to the right columns, but also delete duplicates. Here's the deal:

例如，如果我有A到F的列.如果A到E列与另一行相同，则宏会删除该行并保存较旧的行. 如果A到C列与另一个现有行相同，则宏删除另一行，并将D和E列中的相应值添加到其余行.这是一个示例:

If, for example, I have columns from A to F. If columns A to E are the same with another row, macro deletes the row and saves older one. IF columns A to C are same with another existing row, macro deletes another row and adds those corresponding values from column D and E to the remaining row. Here is an example:

cell1 cell2 cell3 cell4 cell5 cell6
1      1     1     1     1     1
2      2     2     2     2     2
2      2     2     2     2     2
1      1     1     2     2     1
3      3     3     3     3     3

After macro:

cell1  cell2 cell3 cell4 cell5 cell6
1      1     1      3     3     1 
2      2     2      2     2     2
3      3     3      3     3     3 

因此，现在，宏删除了第4行(因为它在A到C列上的值与第1行的值相同)，并从D列和E列的对应值添加到第1行.而且，第2列和第3列是列的重复A到E，因此宏会删除第3行.

So now, macro has deleted row 4 (because it has same values on column A to C as row 1 has) an adds corresponding values from columns D and E to row 1. Also, rows 2 and 3 are duplicates from column A to E, so macro deletes row 3.

这是我尝试过的一个示例(我之前在sum-problem(来自@JvdV)方面获得了帮助，并在正确的值中添加了相应的值，但是我不知道如何正确删除重复项.)

Here is an example what I have tried (I got help before with sum-problem (from @JvdV) and adding corresponding values in to right ones works, but I don't know, how to remove duplicates correctly..)

Class模块:

Public Col1 As Variant
Public Col2 As Variant
Public Col3 As Variant
Public Col4 As Variant
Public Col5 As Variant
Public Col6 As Variant

模块:

Dim x As Long, arr As Variant, lst As Class1
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")

With Sheet1
    x = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr = .Range("A1:F" & x).Value
End With

.Range("A1:F" & x).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6), Header:=xlYes

For x = LBound(arr) To UBound(arr)
    If Not dict.Exists(arr(x, 1) & "|" & arr(x, 2) & "|" & arr(x, 3)) Then
        Set lst = New Class1
        lst.Col1 = arr(x, 1)
        lst.Col2 = arr(x, 2)
        lst.Col3 = arr(x, 3)
        lst.Col4 = arr(x, 4)
        lst.Col5 = arr(x, 5)
        lst.Col6 = arr(x, 6)
        dict.Add arr(x, 1) & "|" & arr(x, 2) & "|" & arr(x, 3), lst
    Else
        dict(arr(x, 1) & "|" & arr(x, 2) & "|" & arr(x, 3)).Col4 = dict(arr(x, 1) & "|" & arr(x, 2) & "|" & arr(x, 3)).Col4 + arr(x, 4)
        dict(arr(x, 1) & "|" & arr(x, 2) & "|" & arr(x, 3)).Col5 = dict(arr(x, 1) & "|" & arr(x, 2) & "|" & arr(x, 3)).Col5 + arr(x, 5)
    End If
Next x

With Sheet1
    x = 1
    For Each Key In dict.Keys
        .Cells(x, 1).Value = dict(Key).Col1
        .Cells(x, 2).Value = dict(Key).Col2
        .Cells(x, 3).Value = dict(Key).Col3
        .Cells(x, 4).Value = dict(Key).Col4
        .Cells(x, 5).Value = dict(Key).Col5
        .Cells(x, 6).Value = dict(Key).Col6
        x = x + 1
    Next Key
End With

End Sub

推荐答案

代码中的一些错误，包括在删除第一个重复项之前填充数组，以及将RemoveDuplicates置于With语句之外并包括F列.您的代码可以正常工作，您可以尝试以下操作:

Some mistakes in your code, including populating your array before deleting first duplicates and having your RemoveDuplicates outside your With statement and including column F. To make your code work properly you could try the below:

_之前

Sub Test()

Dim x As Long, arr As Variant, lst As Class1
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")

With Sheet1

    'Step one: Delete duplicates over columns A-E
    x = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Range("A1:F" & x).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), Header:=xlYes

    'Step two: Populate your array
    x = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr = .Range("A2:F" & x).Value

    'Step three: Clear range
    .Range("A2:F" & x).ClearContents

    'Step Four: Go through your array and populate a dictionary
    For x = LBound(arr) To UBound(arr)
        Set lst = New Class1
        lst.Col1 = arr(x, 1)
        lst.Col2 = arr(x, 2)
        lst.Col3 = arr(x, 3)
        lst.Col4 = arr(x, 4)
        lst.Col5 = arr(x, 5)
        lst.Col6 = arr(x, 6)
        KeyX = Join(Array(arr(x, 1), arr(x, 2), arr(x, 3)), "|")
        If dict.Exists(KeyX) = False Then
            dict.Add KeyX, lst
        Else
            dict(KeyX).Col4 = dict(KeyX).Col4 + arr(x, 4)
            dict(KeyX).Col5 = dict(KeyX).Col5 + arr(x, 5)
        End If
    Next x

    'Step five: Go through your dictionary and write to sheet
    x = 2
    For Each key In dict.Keys
        .Range(.Cells(x, 1), .Cells(x, 6)).Value = Array(dict(key).Col1, dict(key).Col2, dict(key).Col3, dict(key).Col4, dict(key).Col5, dict(key).Col6)
        x = x + 1
    Next key

End With

End Sub

_之后

让我知道这是怎么回事=)

Let me know how it went =)

这篇关于如何在不同情况下(Excel)中删除Excel中的重复项?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！