Question

我需要从一列中删除重复项，但是当发现重复项时，还需要从左侧列的行中删除数据。查看图片：

Sub RemoveDuplicates(rngDataColumn As Range)
'assumes rngDataColumn is a column of data

Dim dic As Object
Dim rngCell As Range
Dim varKey As Variant
Dim lngCounter As Long

'create dictionary
Set dic = CreateObject("Scripting.Dictionary")

'dictionary becomes case sensitive
dic.CompareMode = vbBinaryCompare

'iterate range for unique values
For Each rngCell In rngDataColumn
    If Not dic.Exists(rngCell.Value) Then
        dic.Add Key:=rngCell.Value, Item:=True
    End If
Next rngCell

'clear source range
rngDataColumn.ClearContents

'output unique items - with case sensitivity
lngCounter = 1
For Each varKey In dic.Keys
    rngDataColumn(lngCounter, 1).Value = varKey
    lngCounter = lngCounter + 1
Next varKey

End Sub

我在上面找到了代码，该代码可用于从G列中删除重复项。但是我想从F列中删除相应的数据。例如：如果代码在单元格G10中发现重复，则还应删除单元格F10。

我尝试如上所述创建第二个词典，但失败了。

您能否更正该代码以解决我的问题？

谢谢

Answer 1

这将起作用：

与使用代码时相同，也会从上一列中删除值

Sub RemoveDuplicates(rngDataColumn As Range)
'assumes rngDataColumn is a column of data

Dim dic As Object
Dim dic2 As Object
Dim rngCell As Range
Dim varKey As Variant
Dim lngCounter As Long

'create dictionary
Set dic = CreateObject("Scripting.Dictionary")
Set dic2 = CreateObject("Scripting.Dictionary")

'dictionary becomes case sensitive
dic.CompareMode = vbBinaryCompare
dic2.CompareMode = vbBinaryCompare

'iterate range for unique values
For Each rngCell In rngDataColumn
    If Not dic.Exists(rngCell.Value) Then
        dic.Add Key:=rngCell.Value, Item:=True
        dic2.Add Key:=rngCell.Offset(0, -1).Value & "|" & rngCell.Row(), Item:=True
    End If
Next rngCell

'clear source range
rngDataColumn.ClearContents
rngDataColumn.Offset(0, -1).ClearContents

'output unique items - with case sensitivity
lngCounter = 1

For Each varKey In dic.Keys
    rngDataColumn(lngCounter, 1).Value = varKey
    lngCounter = lngCounter + 1
Next varKey

lngCounter = 1

For Each varKey In dic2.Keys
    rngDataColumn(lngCounter, 1).Offset(0, -1).Value = Split(varKey, "|")(0)
    lngCounter = lngCounter + 1
Next varKey

End Sub

使用区分大小写和附加列删除重复项

1 个答案: