vba - 用于比较两组数据和 ID 排列的 Excel VBA 脚本

Question

我正在编写一个 VBA 脚本，它比较两列数据(每列大约 15,000 行)并确定是否有任何单元格是另一个单元格的排列/。

例如，如果 A1 = 15091 和 B52 = 19510，则该函数会将它们识别为具有相同的字符集。

我设置了一个循环，用于检查 A 列中的每个单独的单元格与 B 列中的每个其他单元格以及循环中的各种功能，但到目前为止，在完成这项任务的任何事情上都没有成功。

此外，由于“数字”格式的单元格将在小数点后全部删除零，因此问题变得更加复杂，因此 15091.1 不会被识别为与 15091.01 相同的字符集。

Answer 1

您可以使用纯 Excel 方法在没有 VBA 的情况下执行此操作。 (尽管找到下面的 VBA 解决方案)这个想法是为每个值构建一种“散列值”，对于一组数字的每个排列都是相同的 - 不与其他散列重叠。

这样做的一种方法是:

计算 0-9 的每个数字的个数(例如 15091 和 19510 将是 1x0、2x1、1x5 和 1x9)

将每个计数乘以 10^digit(例如 1*10^0=1、2*10^1=20、1*10^5=100000、1x10^9=1000000000)

对这些产品求和，(例如 1000100021)

然后，您需要做的就是将这些哈希相互匹配(使用 Excel 的 MATCH 函数)并查看是否找到了某些东西(使用 ISERROR 函数)。

Excel的分步说明(假设您的数据在Sheet1和Sheet2的A列中，从A1开始:

在工作表 1 中:

在顶部插入两行

在 B3 中，放置这个公式 =TEXT(A3,"0") - 这将消除每个数字的剩余部分并将其转换为文本。将公式复制到范围的末尾

在 C1:L1 中，放置数字 0, 1, 2, ...

在 C2:L2 中，放置公式 =10^C1

在 C3 中，放置以下公式:=LEN($B3)-LEN(SUBSTITUTE($B3,C$1,"")) - 并将其复制到右侧直到 L 列并向下复制到列表末尾。这将计算位数

在 M3 中，放置以下公式:=SUMPRODUCT(C3:L3,$C$2:$L$2) - 这将计算散列

在 Sheet2

中重复步骤 2-7

在 Sheet1 中，将此公式放入 N3:=NOT(ISERROR(MATCH(M3,Sheet2!$M:$M,0)))

完毕!

这是一个VBA解决方案:

Option Explicit

Sub IdentifyMatches()
    Dim rngKeys As Range, rngToMatch As Range, rngCell As Range
    Dim dicHashes As Object
    'the range you want to have highlighted in case of a match
    Set rngKeys = Sheets("Sheet1").Range("A3:A5")

    'the range to search for matches
    Set rngToMatch = Sheets("Sheet2").Range("A3:A5")

    Set dicHashes = CreateObject("Scripting.Dictionary")

    'Create dictionary of hashes (dictionary is used for its .Exists property
    For Each rngCell In rngToMatch
        dicHashes(GetHash(rngCell)) = True
    Next

    'Check each cell in rngKey if it has a match
    For Each rngCell In rngKeys
        If dicHashes.Exists(GetHash(rngCell)) Then
            'Action to take in case of a match
            rngCell.Font.Bold = True
            Debug.Print rngCell.Value & " has a match!"
        Else
            rngCell.Font.Bold = False
        End If
    Next

End Sub


Function GetHash(rngValue As Range) As Long
    Dim strValue As String
    Dim i As Integer, digit As Integer
    Dim result As Long
    Dim digits(0 To 9) As Integer

    'Potentially add error check here
    strValue = Format(rngValue.Value, "0")

    For i = 1 To Len(strValue)
        digit = Int(Mid(strValue, i, 1))
        digits(digit) = digits(digit) + 1
    Next i

    For i = 0 To 9
        result = result + 10 ^ i * digits(i)
    Next i

    GetHash = result
End Function

最后但同样重要的是，here's the example file .