Excel удаляет дублирующиеся данные без учета порядка

Question

У меня есть следующие данные

0/3, 1/1, 3/4
1/3, 3/2, 6/2
12/1, 3/6, 3/4
3/4, 0/3, 1/1     'will be considered is duplicate with the first data

Есть ли способ найти и удалить повторяющиеся данные, как это.

Мой текущий метод состоит в том, чтобы разбить на 3 строки на основе "," затем сверьтесь со следующим условием.

'I got each String value by mid command.
'FrstStr1: First String of String 1
'SecStr1: Second String of String 1
'ThrStr1: Third String of String 1
'FrstStr2: First String of String 2
'SecStr2: Second String of String 2
'ThrStr2: Third String of String 2

if (FrstStr1 = FrstStr2 and SecStr1 = SecStr2 and ThrStr1 = ThrStr2) or (FrstStr1 = FrstStr2 and SecStr1 = ThrStr2 and ThrStr1 = SecStr2) or () or () .... then

Я перечислил 6 возможных случаев и поместил их в условие, как указано выше

Это работает, но выглядит глупо.

Интересно, есть ли лучший способ? Excel или VBA независимо от того,

Спасибо за чтение моего вопроса

Answer 1

1. Создание массива путем разделения данных с запятой.
2. И сортировка массива по функциям.
3. Проверка дублированных данных по словарю.

## Код ##

Sub test()
    Dim vR(), vDB
    Dim dic As Object
    Dim v As Variant
    Dim s As String
    Dim i As Long, n As Long

    Set dic = CreateObject("Scripting.Dictionary")

    vDB = Range("a1").CurrentRegion

    For i = 1 To UBound(vDB, 1)
        v = Split(vDB(i, 1), ",")
        s = newArray(v)
        If dic.exists(s) Then
        Else
            dic.Add s, s
            n = n + 1
            ReDim Preserve vR(1 To n)
            vR(n) = vDB(i, 1)
        End If
    Next i
    If n Then
        Range("e1").Resize(n) = WorksheetFunction.Transpose(vR)
    End If


End Sub
Function newArray(v As Variant)
    Dim temp As String
    Dim r As Integer, i As Integer, j As Integer

    r = UBound(v)

    For i = LBound(v) To r - 1
        For j = i + 1 To r
            v(i) = Trim(v(i))
            v(j) = Trim(v(j))
            If v(i) > v(j) Then
                temp = v(j)
                v(j) = v(i)
                v(i) = temp
            End If
        Next j
    Next i
    newArray = Join(v, ",")
End Function

Изображение

Answer 2

Экспонирование Dictionary и ArrayList объектов может привести к очень компактному (и поддерживаемому) коду:

Sub RemoveDuplicatedDataWithoutCountingOrder()

    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")

    Dim j As Long
    Dim key As String
    Dim datum As Variant, couple As Variant
    For Each datum In Range("A1").CurrentRegion.Value
        key = vbNullString
        With CreateObject("System.Collections.SortedList")
            For Each couple In Split(Replace(datum, " ", vbNullString), ",")
                .Add couple, 0
            Next
            For j = 0 To .Count - 1
                key = key & .getkey(j)
            Next
            If Not dict.exists(key) Then dict.Add key, datum
        End With
    Next

    Range("C1").Resize(dict.Count) = Application.Transpose(dict.items)

End Sub