将一个街道地址与一列街道地址进行比较以找到匹配项

Question

我有两个数据源，分别包含街道地址名称、城市和邮政编码，我想找出哪些地址的匹配百分比最高并返回最大值。我有一个 VBA 代码，可以匹配两个单元格字符串“地址比较”，但需要将一个地址与整个列进行比较。

请查看附件中的 VBA 代码示例。一个图像包含用于匹配两个单元格的“地址比较”，而另一个代码使用 For 循环来索引列并调用“地址比较”模块将索引列与特定单元格进行比较。

我不知道如何将匹配的百分比保存在数组中并返回最大值。有什么可以帮我的吗？

Function AddressCompare(first_string As String, Second_string As String, _
                               Comparing_Letters As Integer) As Double
  Dim int_character As Integer, Comparing_LettersMatch As Integer
  Dim n_Gram_List1 As String, n_Gram_List2 As String, n_letter_Gram As Variant
  Dim n_Gram_array1 As Variant

  For int_character = 1 To Len(first_string) - (Comparing_Letters - 1)
      If n_Gram_List1 <> "" Then n_Gram_List1 = n_Gram_List1 & ","
      n_Gram_List1 = n_Gram_List1 & Mid(first_string, int_character, Comparing_Letters)
  Next int_character

  For int_character = 1 To Len(Second_string) - (Comparing_Letters - 1)
      If n_Gram_List2 <> "" Then n_Gram_List2 = n_Gram_List2 & ","
      n_Gram_List2 = n_Gram_List2 & Mid(Second_string, int_character, Comparing_Letters)
  Next int_character

  n_Gram_array1 = Split(n_Gram_List1, ",")

  For Each n_letter_Gram In n_Gram_array1
      If InStr(1, n_Gram_List2, n_letter_Gram) Then
        Comparing_LettersMatch = Comparing_LettersMatch + 1
      End If
  Next n_letter_Gram

  AddressCompare = Comparing_LettersMatch / (UBound(n_Gram_array1) + 1)
End Function




Function MatchAddyCompare(first_string As String, Arr1rng As Range) As Double
  Dim Arr1() As String: Arr1 = Arr1rng.Value
  Dim i As Integer
  Dim ArrayLen As Integer
  Dim MACC() As Variant
  ArrayLen = UBound(Arr1) - LBound(Arr1) + 1
  For i = 1 To ArrayLen
      Call AddressCompare(first_string, Arr1(i), 2)
      'MACC(i) = AddressCompare
  Next i
  'MatchAddyCompare = AddressCompare
 
End Function

我添加了第二条消息，以便每个人都能看到，如果我直接使用“AddressCompare”函数比较两个单元格，我会得到 81% 的匹配率，这很棒。但是，我需要一个可以运行一个单元格与整个列并返回最高匹配百分比的代码。