请求修改VBA宏：实现两列字符串80%匹配判定功能

嘿，我帮你调整了VBA宏代码，把原来只对比前20字符的逻辑改成了按80%匹配度判断的需求。下面是完整的修改后的代码，还有关键改动的说明：

完整代码 #

Sub Macro1()
    ' Match Organization names with 80% similarity check
    Dim sht As Worksheet
    Dim LR As Long
    Dim i As Long
    Dim str As String, str1 As String
    Dim matchPercent As Double
    
    ' 替换成你的目标工作表名称
    Set sht = ActiveWorkbook.Worksheets("Sheet1")
    ' 假设客户类型列是A列，这里获取最后一行的行号，按需修改
    LR = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
    
    ' 从第2行开始遍历（跳过表头）
    For i = 2 To LR
        ' 判断当前行客户类型是否为"O"
        If sht.Cells(i, "A").Value = "O" Then
            ' 获取需要对比的两个字符串（假设在B列和C列，按需修改）
            str = Trim(sht.Cells(i, "B").Value)
            str1 = Trim(sht.Cells(i, "C").Value)
            
            ' 调用自定义函数计算匹配度
            matchPercent = GetMatchPercentage(str, str1)
            
            ' 根据匹配度输出结果（结果输出到D列，按需修改）
            sht.Cells(i, "D").Value = IIf(matchPercent >= 0.8, "ok", "check")
        End If
    Next i
End Sub

' 自定义函数：计算两个字符串的匹配度（相同位置字符数占较长字符串的比例）
Function GetMatchPercentage(str1 As String, str2 As String) As Double
    Dim minLen As Integer, maxLen As Integer
    Dim matchCount As Integer
    Dim i As Integer
    
    matchCount = 0
    minLen = IIf(Len(str1) < Len(str2), Len(str1), Len(str2))
    maxLen = IIf(Len(str1) > Len(str2), Len(str1), Len(str2))
    
    ' 处理空字符串的情况
    If maxLen = 0 Then
        GetMatchPercentage = 0
        Exit Function
    End If
    
    ' 逐字符对比相同位置的字符
    For i = 1 To minLen
        If Mid(str1, i, 1) = Mid(str2, i, 1) Then
            matchCount = matchCount + 1
        End If
    Next i
    
    ' 计算匹配度比例
    GetMatchPercentage = matchCount / maxLen
End Function

关键改动说明 #

• 新增匹配度计算函数：GetMatchPercentage会统计两个字符串相同位置的字符数量，然后除以较长字符串的长度，得到匹配比例。
• 替换原对比逻辑：不再只截取前20字符对比，而是计算完整字符串的匹配度；如果还是需要仅对比前20个字符，只需要修改字符串赋值部分：

  str = Trim(Left(sht.Cells(i, "B").Value, 20))
  str1 = Trim(Left(sht.Cells(i, "C").Value, 20))
  

• 按匹配度输出结果：当匹配度≥80%时返回"ok"，否则返回"check"，结果输出列可以根据你的表格调整。

注意事项 #

• 记得把代码中的工作表名称、列号（客户类型列、对比字符串列、结果列）改成你实际使用的位置。
• 当前的匹配逻辑是逐位置字符匹配，如果需要更智能的匹配（比如忽略大小写、分词匹配），可以在GetMatchPercentage函数里进一步调整（比如先把字符串转成小写再对比）。

内容的提问来源于stack exchange，提问作者user2574