string - 在 Excel VBA 项目中匹配相似但不完全相同的文本字符串

Question

好吧，我一直在努力寻找解决方案，但似乎找不到解决方案。我什至无法正确分解问题。这就是想法。

我有两张有很多行的工作表(一张有 800，另一张有 300,000)。每行包含一个名称列，然后包含有关该名称的信息的几列。每张纸都有不同种类的信息。

我想根据这两个工作表都具有的名称列将它们合并到一个主工作表中，因此合并功能非常适合此目的。现在的问题是名称不完全匹配。

例如 Sheet1 包含

“Company B.V.”、“信息 #1”
“公司总计”，“信息 #2”
“有限公司”，“信息#3”

并且工作表 2 包含

“公司和公司”，“信息#4”
“公司和公司”，“信息#5”

工作表 1 包含将要使用的所有名称(大约 100 个，但形式如上所述不同)，工作表 2 包含多行中的所有这 100 个名称以及不在 100 个列表中的名称，因此我不在乎。

我如何制作一个 VBA 代码项目，其最终结果将是这样的，主表:

“公司”、“信息#1”、“信息#2”、“信息#3”、“信息#4”、“信息#5”

对于其中的每一个“公司”(100 家名单)？

我希望有一个解决方案。我对 VBA 项目还很陌生，但我之前已经做过一些最少的编码。

Answer 1

我会将宏放在您的个人部分中，这样宏就可以在所有工作表中使用。通过录制虚拟宏并选择将其存储在个人宏工作簿中来执行此操作。现在您可以在此个人工作簿中手动添加新的宏和函数。

我刚刚尝试了这个(不知道原始出处)，效果很好。

公式如下所示:=PERSONAL.XLSB!FuzzyFind(A1,B$1:B$20)

代码在这里:

Function FuzzyFind(lookup_value As String, tbl_array As Range) As String
Dim i As Integer, str As String, Value As String
Dim a As Integer, b As Integer, cell As Variant
For Each cell In tbl_array
  str = cell
  For i = 1 To Len(lookup_value)
    If InStr(cell, Mid(lookup_value, i, 1)) > 0 Then
      a = a + 1
      cell = Mid(cell, 1, InStr(cell, Mid(lookup_value, i, 1)) - 1) & Mid(cell, InStr(cell, Mid(lookup_value, i, 1)) + 1, 9999)
    End If
  Next i
  a = a - Len(cell)
  If a > b Then
    b = a
    Value = str
  End If
  a = 0
Next cell
FuzzyFind = Value
End Function