Question

好的，我一直在努力寻找解决方案，而我似乎无法做到。我甚至无法正确地解决问题。这就是主意。

我有两张有很多行的纸张（一张有800张，另一张有300张）。每行包含一个Name列，然后包含几个包含有关此Name的信息的列。每张表都有不同类型的信息。

我想基于这两个名称列将这两张表合并到主表中，因此合并功能非常适用于此。现在的问题是名称不完全匹配。

例如Sheet1包含

“公司B.V.”，“信息＃1”
“公司总计”，“信息＃2”
“Company Ltd”，“Info＃3”

和表2包含

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

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

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

“公司”，“信息＃1”，“信息＃2”，“信息＃3”，“信息＃4”，“信息＃5”

对于那里的每一个“公司”（100个名单）？

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

Answer 1

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

我刚试过这个（不知道原始来源）并且工作正常。

公式如下：= 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

Answer 2

我使用了Robert解决方案，它对我来说很好。我正在为那些擅长excel但知道编码的人发布完整的解决方案：

虽然这个帖子已经老了，但是我从另一个线程中获取了一些代码并尝试了，看起来解决方案正在给出近似匹配。在这里，我尝试将一列sheet1与一列sheet2匹配：

在Excel中添加命令按钮
下面的代码和点击/运行按钮，功能为您提供所选列的结果

 Private Sub CommandButton21_Click()
     Dim ws As Worksheet
     Dim LRow As Long, i As Long, lval As String


   '~~> Change this to the relevant worsheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

With ws
    '~~> Find Last Row in Col G which has data
    LRow = .Range("D" & .Rows.Count).End(xlUp).Row

    If LRow = 1 Then
        MsgBox "No data in column D"
    Else
        For i = 2 To LRow


             lval = "D"
            .Range("G" & i).Value = FuzzyFind(lval & i, .Range("PWC"))
        Next i
    End If
    End With

    End Sub


    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
      If Value <> "" Then
         FuzzyFind = Value
      Else
         FuzzyFind = "None"
      End If
End Function

Answer 3

您可以使用Google Excel UDF模糊查找或Levensthein距离。有一些UDF浮出水面，微软确实有一个模糊的查找/匹配插件（当我使用它时，它很容易崩溃，而且不直观）。

Answer 4

查看this DDoE post上的功能。您可以生成最长的公共序列字符串，并将长度与原始字符串进行比较。喂它一些已知的匹配和一些非接近的匹配，看看你是否能看到它们之间有明确的分界线。

这些函数用于差异，而不是找到近似匹配，但它们可能适合你。

Answer 5

并非完全相同，但处理我的问题的人可能会找到此页面在搜索时。

任务：一直在汽车残骸中的患者名单，包括街道地址。根据相同的街道地址查找相关帐户。该列表最多可能包含120条记录 - 因此部分手动审核是切合实际的。

问题：街道地址相似但不相同，例如123 JONES LANE和123 JONES LN或72 MAIN STREET＃32 and 72 MAIN STREET＃32。

该解决方案的

部分仅比较街道号码。对于具有相同街道号码的两个不同地址（例如，123 JONES LANE和123 MAIN STREET），列表的大小是不寻常的。

警告：您无法使用VAL（）来提取街道号码。尝试使用167 E 13 ST。 VBA将其视为167 ^ 13，如果您输出到Street_Num As Integer，则会崩溃。因此，您必须使用循环将数字拉入新字符串并停在第一个非数字字符处。

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

5 个答案: