Question

我想写一个代码来擦除一行不确定大小的重复值，即我不知道重复值将出现在何处。

我认为我可以在一个范围内使用RemoveDuplicates属性，但它仅适用于列中的重复项。这就是为什么我被堆积。

在运行代码之前就是这种情况：

这是我想要的结果：

我真的很希望有一个代码，可以像我所说的那样对rows.count使用可调整大小的范围，我不知道重复的位置会出现，并且行可能很长（最多500条记录）。

这是尝试过的方法，但显然不能使用，因为行中没有“删除重复项”属性：

Sub RemoveDuplicates()
Dim ws1 As Worksheet

Set ws1 = Sheets("Sheet1")

Dim rng As Range

Dim LastCol As Integer

 With ws1

    LastCol = .Cells(2, Columns.Count).End(xlToLeft).Column

    Set rng = .Range(.Cells(2, 1), .Cells(2, LastCol))

    rng.RemoveDuplicates ????

End With

我将不胜感激。

Answer 1

你可以那样做

Sub RemoveDuplicates()
    Dim ws1 As Worksheet
    Set ws1 = Sheets("Sheet1")

    Dim rng As Range   
    Dim LastCol As Integer

    With ws1
        LastCol = .Cells(2, Columns.Count).End(xlToLeft).Column    
        Set rng = .Range(.Cells(2, 1), .Cells(2, LastCol))
        'rng.RemoveDuplicates ????
    End With

    Dim v As Variant
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    v = rng
    Dim i As Long
    For i = LBound(v, 2) To UBound(v, 2)
        If dict.Exists(v(1, i)) Then
            v(1, i) = vbNullString
        Else
            dict.Add v(1, i), v(1, i)
        End If
    Next i
    rng = v
End Sub

Answer 2

SET数据结构更适合这种操作，但是Excel提供了Dictionary，并且正如注释中提到的Shai Radio一样，可以在此处使用它。将此引用到项目中的参考字典 Does VBA have Dictionary Structure?

然后可以将您的代码修改为以下内容：

Sub RemoveDuplicates()
    Dim ws1 As Worksheet
    Set ws1 = Sheets("Sheet1")
    Dim rng As Range
    Dim dict As New Scripting.Dictionary
    Dim LastCol As Integer
    With ws1
        LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
        For i = 1 To LastCol
            If Not dict.Exists(.Cells(1, i).Value) Then
                dict.Add .Cells(1, i).Value, 1
            Else
                .Cells(1, i).ClearContents
            End If
        Next i
    End With
End Sub

Answer 3

如果您想在类似行的范围内使用RemoveDuplicates()功能，则可以使用类似“帮助程序”列的范围将数据放入RemoveDuplicates并将结果粘贴回您的原始范围

Sub RemoveDuplicates()
    Dim ws1 As Worksheet        
    Set ws1 = Sheets("Sheet1")

    Dim dataRng As Range, helpRng As Range

    With ws1        
        Set dataRng = .Range("A2", .Cells(2, Columns.Count).End(xlToLeft)) ' this is your original data range

        With .UsedRange
            Set helpRng = .Cells(1, .Columns.Count + 1).Resize(dataRng.Columns.Count) ' ' this is "out of town" helper range, with as many rows as your data range columns
        End With

        With helpRng
            .Value = Application.Transpose(dataRng.Value)
            .RemoveDuplicates Columns:=Array(1), Header:=xlNo
            dataRng.Value = Application.Transpose(.Value)
            .Clear
        End With
    End With
End Sub

在不确定大小的行中擦除重复值

3 个答案: