在 Excel VBA 项目中匹配相似但不精确的文本字符串
Posted
技术标签:
【中文标题】在 Excel VBA 项目中匹配相似但不精确的文本字符串【英文标题】:Matching similar but not exact text strings in Excel VBA projects 【发布时间】:2012-10-28 18:48:24 【问题描述】:好的,我一直在尝试为此找到解决方案,但我似乎无法做到。我什至无法正确分解问题。就是这个想法。
我有两张多行的工作表(一张有 800 行,另一张有 300,000 行)。每行包含一个名称列,然后是几个包含有关此名称的信息的列。每张表都有不同种类的信息。
我想将这两个工作表合并为一个基于它们都有的名称列的主工作表,因此合并功能非常适合。现在的问题是名称不完全匹配。
例如 Sheet1 包含
“公司 B.V.”、“信息 #1” “公司总数”、“信息 #2” “公司”、“信息 #3”
并且工作表 2 包含
“公司和公司”、“信息 #4” “公司和公司”、“信息 #5”
表 1 包含将要使用的所有名称(大约 100,但如上所述以不同的形式),表 2 包含多行中的所有这 100 个名称以及不在 100 列表中的名称,因此我不在乎。
我如何制作一个 VBA 代码项目,最终结果是这样的,主表:
“公司”、“信息#1”、“信息#2”、“信息#3”、“信息#4”、“信息#5”
对于其中的每一个“公司”(100 个列表)?
我确实希望有一个解决方案。我对 VBA 项目还很陌生,但我以前做过一些最小的编码。
【问题讨论】:
您需要决定哪些规则构成“Company B.V.”与“公司和公司”相同。然后应用它们进行转换。例如。它总是第一个词吗?或者替换一组单词(b.v./total/and co.)后还剩下什么? ......如果你不能清楚地表达出来,你将无法做到这一点。 您必须为“足够相似”的含义设置某种标准...例如,仅根据2张?? 是的,你都对,不幸的是,第一个词不是一个选项。是否有可能找到两个字符串之间匹配的最小字符长度,并将其用作“公司”名称,即整个单词应该完美匹配,包括前后的空格。 一个单元格中大于 4 个字符的所有单词应该完全匹配怎么办?这是一个“可制造”的条件吗? ... 鉴于上面的示例,带有Company Total
的单元格将不符合 4 字符标准,因此请确保您对此感到满意,但如果您没问题,我会写一个简单的 VBA 函数,它将一个单元格(或字符串)和一个整数(用于匹配的字符数)作为输入。然后它将检查该字符串中的每个单词-如果它比所需的字符数长,则将其附加到输出字符串中-然后,一旦它们通过此函数,您就可以比较这两个单元格的值...仅挑战是这些单词在单元格中的顺序是否不同。
【参考方案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
【讨论】:
非常感谢您提供此代码!如果从查找值中找不到大于(例如)4 个字符或更多字符的匹配项,是否可以不返回任何内容(空白单元格)?【参考方案2】:您可以使用 Google Excel UDF 模糊查找或 Levensthein 距离。有一些 UDF 浮动,微软也有一个模糊查找/匹配插件(当我使用它时,它很容易崩溃并且不直观)。
【讨论】:
这看起来和我需要的完全一样,但是我得到一个编译错误(“变量未定义”),就像这篇文章一样:mrexcel.com/forum/excel-questions/…【参考方案3】:我使用了 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
【讨论】:
【参考方案4】:看看this DDoE post 上的函数。您可以生成一个最长的公共序列字符串并将其长度与原始字符串进行比较。给它一些已知的匹配项和一些接近的不匹配项,看看你是否能看到它们之间的清晰分界线。
这些函数用于比较,而不是寻找相近的匹配,但它们可能对你有用。
【讨论】:
这些函数看起来对我的问题非常有用。如果我有两个想要相互匹配的不同字符串,我会先使用 LCSTable,然后将该表用作 LCSString 函数的输入?【参考方案5】:不完全正确但类似,处理我的问题的人可能会找到这个页面搜索时。
任务:出现车祸的患者名单,包括街道地址。根据相同的街道地址查找相关帐户。该列表最多可能有 120 条记录 - 所以部分人工审核是现实的。
问题:街道地址相似但不相同,例如123 JONES LANE 和 123 JONES LN 或 72 MAIN STREET #32 和 72 MAIN STREET #32。
部分解决方案是仅比较街道号码。对于这样大小的列表,具有相同街道编号的两个不同地址是不常见的(例如,123 JONES LANE 和 123 MAIN STREET)。
注意:您不能使用 VAL() 来提取门牌号。试试 167 E 13 ST。 VBA 将其视为 167^13,如果您将 Street_Num 作为整数输出,则会崩溃。因此,您必须使用循环将数字拉入新字符串并在第一个非数字字符处停止。
【讨论】:
以上是关于在 Excel VBA 项目中匹配相似但不精确的文本字符串的主要内容,如果未能解决你的问题,请参考以下文章