Создание UDF с использованием VBA в Excel, чтобы найти похожие значения в строке, где порядок не имеет значения

Question

Я имею дело с неограниченным количеством новых строк данных каждый день, и мне нужен UDF, который бы находил одинаковые значения строк независимо от их порядка. Как видно из приведенного ниже примера, A9:F9 и A4:F4 имеют аналогичные значения строк, помеченные как ПОДОБНАЯ СТРОКА 1. Вам нужно просмотреть общие данные в строке, чтобы увидеть, что они имеют одинаковые значения, но не в том же порядке. Я не знаком с VBA, если кто-то может помочь мне, это будет очень цениться. Я искал это по всей сети сейчас.

Пример формулы:

=Similarity(Range Of Data from A:F, Row Of Data)

Мой лист выглядит как на картинке ниже:

Answer 1

Пожалуйста. попробуйте с кодом ниже

Sub test()
    Dim data() As String
    Dim i As Long
    Dim dd As Long
    Dim lastrow As Variant
    Dim lastcolumn As Variant
    Dim status As Boolean
    lastrow = Range("A" & Rows.Count).End(xlUp).Row
    lastcolumn = Cells(2, Columns.Count).End(xlToLeft).Column
    ReDim data(lastrow - 1, lastcolumn)
    For i = 2 To lastrow
        For j = 1 To lastcolumn
            data(i - 1, j) = Cells(i, j)
        Next j
    Next i
    For i = 1 To lastrow - 1
        Call similarity(data(), i)
    Next i
End Sub


Public Function similarity(rdata() As String, currrow As Long)
    lastrow = UBound(rdata)
    matchcount = 0
    lastcolumn = UBound(rdata, 2)
    For Z = currrow To lastrow - 1
        ReDim test(lastcolumn) As String
        ReDim test1(lastcolumn) As String
        For i = 1 To lastcolumn
            test(i) = rdata(currrow, i)
            test1(i) = rdata(Z + 1, i)
        Next i
        Call sort(test())
        Call sort(test1())
        For i = 1 To lastcolumn
            If test(i) = test1(i) Then
                matchcount = matchcount + 1
            End If
        Next i
        If matchcount = lastcolumn Then
            If Cells(currrow + 1, lastcolumn + 1).Value <> "" Then
                Cells(currrow + 1, lastcolumn + 1).Value = Cells(currrow + 1, lastcolumn + 1).Value & "|" & "Match with " & Z + 2
            Else
                Cells(currrow + 1, lastcolumn + 1).Value = "Match with " & Z + 2
            End If
            If Cells(Z + 2, lastcolumn + 1).Value <> "" Then
                Cells(Z + 2, lastcolumn + 1).Value = Cells(Z + 2, lastcolumn + 1).Value & "|" & "Match with " & currrow + 1
            Else
                Cells(Z + 2, lastcolumn + 1).Value = "Match with " & currrow + 1
            End If
        End If
        matchcount = 0
    Next Z
End Function

Sub sort(list() As String)
    Dim First As Integer, Last As Long
    Dim i As Long, j As Long
    Dim temp As String

    First = LBound(list)
    Last = UBound(list)
    For i = First To Last - 1
        For j = i + 1 To Last
            If list(i) > list(j) Then
                temp = list(j)
                list(j) = list(i)
                list(i) = temp
            End If
        Next j
    Next i
End Sub

Answer 2

Вот начало. Это поможет вам найти, какие строки являются перестановками других строк. Скажем, мы начнем с:

Этот UDF() будет принимать содержимое набора ячеек; сортировать данные; объединить данные; и вернуть результат в виде одной строки:

Public Function SortRow(rng As Range) As String
    ReDim ary(1 To rng.Count) As Variant
    Dim CH As String, i As Long
    CH = Chr(2)
    For i = 1 To 6
        ary(i) = rng(i)
    Next i
    Call aSort(ary)
    SortRow = Join(ary, CH)
End Function

Public Sub aSort(ByRef InOut)

    Dim i As Long, J As Long, Low As Long
    Dim Hi As Long, Temp As Variant

    Low = LBound(InOut)
    Hi = UBound(InOut)

    J = (Hi - Low + 1) \ 2
    Do While J > 0
        For i = Low To Hi - J
          If InOut(i) > InOut(i + J) Then
            Temp = InOut(i)
            InOut(i) = InOut(i + J)
            InOut(i + J) = Temp
          End If
        Next i
        For i = Hi - J To Low Step -1
          If InOut(i) > InOut(i + J) Then
            Temp = InOut(i)
            InOut(i) = InOut(i + J)
            InOut(i + J) = Temp
          End If
        Next i
        J = J \ 2
    Loop
End Sub

Итак, в G1 мы входим:

=SortRow(A1:F1)

и скопируйте вниз и в H1 введите:

=IF(COUNTIF($G$1:$G$7,G1)=1,"unique combination","duplicates")

и скопируйте вниз:

Это показывает, что строки 2 и 6 имеют дублированные данные, но в другом порядке.

Исходя из этого может помочь вам достичь своей цели.