Стереть дублированное значение в строке неопределенного размера

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 предоставляет словарь, и, как упомянул в комментариях Shai Radio, его можно использовать здесь. Обратитесь к справочному словарю в вашем проекте Имеет ли VBA словарную структуру?

Ваш код может быть изменен следующим образом:

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