Question

我每天处理无限量的新数据行，我需要一个 UDF ，无论顺序如何，都会找到类似的行值。正如您在示例中所见， A9：F9 和 A4：F4 具有标记为 SIMILAR ROW 1 的类似行值。您需要查看行中的整体数据，以查看它具有相同的值但不是相同的顺序。我不熟悉VBA如果有人能帮助我，我会非常感激。我现在一直在网上搜索这个。

公式示例：

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

我的表格如下图所示：

Answer 1

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

开始

这个 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行的数据是重复的，但顺序不同。

从此开始可能有助于您实现目标。

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，以便在顺序无关紧要的行中查找类似的值

2 个答案: