使用 excel 中的 VBA 创建 UDF 以在顺序无关紧要的行中查找相似值

Question

我每天都在处理无限多的新数据行，我需要一个 UDF 来查找相似的行值，而不管其顺序如何。正如您在下面的示例中看到的，A9:F9 和 A4:F4 具有相似的行值，标记为 SIMILAR ROW 1 。您需要查看行内的整体数据，看看它是否具有相同的值但顺序不同。我不熟悉 VBA 如果有人可以帮助我，我将不胜感激。我现在一直在网上搜索这个。

公式示例：

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

我的 sheet 看起来像下图：

Answer 1

这是一个开始。它将帮助您找到哪些行是其他行的 permutations。假设我们开始于：

这个UDF()将获取一组单元格的内容；对数据进行排序；连接数据；和 return 作为单个字符串的结果：

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:$G,G1)=1,"unique combination","duplicates")

并复制下来：

这表明第 2 行和第 6 行有重复的数据，但顺序不同。

从这里开始可能会帮助您实现目标。

Answer 2

请问。试试下面的代码

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

使用 excel 中的 VBA 创建 UDF 以在顺序无关紧要的行中查找相似值

Creating UDF using VBA in excel to find similar values in a row where order does not matter

excel

vba

excel-udf