按字匹配兩個標題並計算％

Question

我試圖自動化一個在A列和B列都有標題的Excel文件，並且我必須從B中搜索A中的每個單詞並通過使用「no of words匹配/總字數（在A欄）「公式。

我使用下面的代碼，但它沒有給我標題重複詞（重複詞）的準確％。

Sub percentage() 
 
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 
 
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) 
 
Next 
 
End Sub

如果名稱1：非常好的包與尼斯打印和標題2：尼斯打印然後尼斯包的結果應該是3/6，即67％。

但我得到的結果爲100％。

任何人都可以幫助我。

標題是

幹得啞彈

與尼斯打印

非常好的包舉成功和成功的過程

不要吃太多。如果你吃得太多，你會生病

我已經試過= noDuplicate（celladdress）

Answer 1

首先，你應該刪除重複的字在列B

我的函數刪除字和回報不重複的單詞數組。

Function noDuplicate(ByVal str As String) As String() 
Dim splitStr() As String 
Dim result() As String 
Dim i As Integer 
Dim j As Integer 
Dim k As Integer 
Dim addFlag As Boolean 

splitStr = Split(UCase(str), " ") 
ReDim result(UBound(splitStr)) 

' 
result(0) = splitStr(0) 
k = 0 
For i = 1 To UBound(splitStr) 
    addFlag = True 
    For j = 0 To k 
     If splitStr(i) = result(j) Then 
      addFlag = False 
      Exit For 
     End If 
    Next j 

    If addFlag Then 
     result(k + 1) = splitStr(i) 
     k = k + 1 
    End If 
Next i 
ReDim Preserve result(k) 
noDuplicate = result 
End Function 

然後計算字匹配字和號數的百分比在列A

Function percentMatch(ByVal colA As String, ByVal colB As String) As Double 
Dim splitColA() As String 
Dim splitColB() As String 
Dim i As Integer 
Dim j As Integer 
Dim matchCount As Integer 

splitColA = Split(UCase(colA), " ") 
splitColB = noDuplicate(colB) 

matchCount = 0 
For i = 0 To UBound(splitColA) 
    For j = 0 To UBound(splitColB) 
     If splitColA(i) = splitColB(j) Then 
      matchCount = matchCount + 1 
      Exit For 
     End If 
    Next j 
Next i 

percentMatch = matchCount/(UBound(splitColA) + 1) 
End Function 

添加這兩個功能後，您可以編寫新的代碼下面

Sub percentage() 
Dim aRng As Range, cel As Range 

Set aRng = Range(Range("A1"), Range("A5").End(xlDown)) 
For Each cel In aRng 
    cel.Offset(0, 2).Value = percentMatch(cel.Value, cel.Offset(0, 1).Value) 
Next 
End Sub 

注意，我不保護函數中的空字符串。

Answer 2

如果您通過代碼F8，你可以看到這個問題。

列A中的第一個循環遍歷B列並計數2次出現。 A列中的包裝通過B列循環並計數1次出現。 列A中的第二個Nice通過列B循環並計數2次出現。 在列A中打印循環通過列B並計數1發生。

所以你得到6列對A列6個單詞的計數; 100％

如果添加一個隨機單詞列A，你會得到6出的7