我需要将相应的值汇总到右侧的列中,但也需要删除重复项。这是交易:
例如,如果我有从 A 到 F 的列。如果 A 到 E 列与另一行相同,则宏将删除该行并保存旧行。
如果 A 至 C 列与另一现有行相同,宏将删除另一行并将 D 和 E 列中的相应值添加到剩余行。这是一个例子:
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 行。
这是我尝试过的一个例子(我之前得到了有关求和问题的帮助(来自@JvdV)并将相应的值添加到正确的值中,但我不知道如何正确删除重复项..)
类模块:
Public Col1 As Variant
Public Col2 As Variant
Public Col3 As Variant
Public Col4 As Variant
Public Col5 As Variant
Public Col6 As Variant
Module:
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