匹配两个标题中的单词并计算％

Question

我试图自动化一个在A和B列中都有标题的Excel文件，我必须在B中搜索A中的每个单词并使用“no of words matched / total no of words”来计算％专栏A）“公式。

我正在使用以下代码，但它没有给我准确的％。任何人都可以帮帮我。

Sub percentage()

Dim a() As String
Dim b() As String
Dim aRng As Range
Dim cel As Range
Dim i As Integer, t As Integer, clm As Integer

Set aRng = Range(Range("A1"), Range("A65536").End(xlDown))

For Each cel In aRng
    a = Split(cel, " ")
    b = Split(cel.Offset(, 1), " ")
    d = 0
    clm = 2
    C = UBound(a)
If cel.Value <> "" Then
    For i = LBound(a) To UBound(a)
    
            For t = LBound(b) To UBound(b)
                If UCase(a(i)) = UCase(b(t)) Then
                    clm = 2
                 Do While True
                    If UCase(cel.Offset(, clm)) = UCase(a(i)) Then
                    Exit Do
                    End If
                        If cel.Offset(, clm) = "" Then
                            'cel.Offset(, clm) = a(i)
                            Exit Do
                        End If
                        clm = clm + 1
                    Loop
                    d = d + 1
                End If
            
            Next
            
    Next

cel.Offset(0, 2).Value = (d / c)
End If
Next

End sub

Answer 1

请进行更改。 c = UBound(a) + 1 'change here 乘以100并使用舍入函数cel.Offset(0, 2).Value = (d / c) 您的程序代码应该可以正常工作。

******编辑于2015年9月28日********* 对于OP的问题，另一个版本的程序被我认为是更好的方法。

****编辑29-09-2015 ****** 对字符串中不同单词组合的程序重新测试表明，该程序更新并未在所有类型的情况下给出一致的结果，因此，2015年9月28日的程序更新被撤销。

Sub percentage_rev()
   Dim a() As String, b() As String
   Dim aRng As Range, cel As Range
   Dim i As Integer, t As Integer
   Set aRng = Range(Range("A1"), Range("A5").End(xlDown))
   For Each cel In aRng

       a = Split(Trim(cel), " ")
       b = Split(Trim(cel.Offset(, 1)), " ")
       d = 0
       c = UBound(a) + 1 'change here

    If cel.Value <> "" Then
      If InStr(cel, cel.Offset(, 1)) Then
          d = UBound(b) + 1
    Else
         For i = LBound(a) To UBound(a)
             For t = LBound(b) To UBound(b)
                 If UCase(a(i)) = UCase(b(t)) Then
                     d = d + 1
                 End If
           Next
        Next
     End If
    End If
   cel.Offset(0, 2).Value = (d / c) * 100 'multiply by 100 for percentage
   Next
End Sub