在短語內計數並突出顯示關鍵字

Question

我有一個有兩列的excel表。第一列是關鍵短語，第二列是消息。關鍵短語可能出現在消息列中。我需要知道消息列中發生了多少次關鍵短語。請建議一些簡單易行的方法。

關鍵短語是一列，消息是第二列。消息列是1個或多於1個關鍵短語的組合（連接）。我需要找出每條消息包含多少關鍵短語。

Answer 1

您可能可以通過模塊子程序收集高效的計數，該子程序執行存儲器陣列中的所有數學運算並將計數返回工作表。

我使用了一些標準的Lorem Ipsum關鍵字和短語創建上述樣本數據。

點擊Alt鍵 + F11和VBE打開時，立即使用下拉菜單插入►模塊（Alt鍵 + 我，中號）。將以下內容粘貼到名爲Book1 - Module1（Code）的新模塊代碼表中。

Option Explicit 

Sub count_strings_inside_strings() 
    Dim rw As Long, lr As Long 
    Dim k As Long, p As Long, vKEYs As Variant, vPHRASEs As Variant, vCOUNTs As Variant 

    ReDim vKEYs(0) 
    ReDim vPHRASEs(0) 

    With Worksheets("Sheet1") '<~~ set to the correct worksheet name\ 
     'populate the vKEYs array 
     For rw = 2 To .Cells(Rows.Count, 1).End(xlUp).Row 
      vKEYs(UBound(vKEYs)) = LCase(.Cells(rw, 1).Value2) 
      ReDim Preserve vKEYs(UBound(vKEYs) + 1) 
     Next rw 
     ReDim Preserve vKEYs(UBound(vKEYs) - 1) 

     'populate the vPHRASEs array 
     For rw = 2 To .Cells(Rows.Count, 2).End(xlUp).Row 
      vPHRASEs(UBound(vPHRASEs)) = LCase(.Cells(rw, 2).Value2) 
      ReDim Preserve vPHRASEs(UBound(vPHRASEs) + 1) 
     Next rw 
     ReDim Preserve vPHRASEs(UBound(vPHRASEs) - 1) 
     ReDim vCOUNTs(0 To UBound(vPHRASEs)) 

     'perform the counts 
     For p = LBound(vPHRASEs) To UBound(vPHRASEs) 
      For k = LBound(vKEYs) To UBound(vKEYs) 
       vCOUNTs(p) = CInt(vCOUNTs(p)) + _ 
        (Len(vPHRASEs(p)) - Len(Replace(vPHRASEs(p), vKEYs(k), vbNullString)))/Len(vKEYs(k)) 
      Next k 
     Next p 

     'return the counts to the worksheet 
     .Cells(2, 3).Resize(UBound(vCOUNTs) + 1, 1) = Application.Transpose(vCOUNTs) 

     'run the helper procedure to Blue|Bold all of the found keywords within the phrases 
     Call key_in_phrase_helper(vKEYs, .Range(.Cells(2, 2), .Cells(Rows.Count, 2).End(xlUp))) 

    End With 
End Sub 

Sub key_in_phrase_helper(vKYs As Variant, rPHRSs As Range) 
    Dim p As Long, r As Long, v As Long 

    With rPHRSs 
     For r = 1 To rPHRSs.Rows.Count 
      .Cells(r, 1) = .Cells(r, 1).Value2 
      For v = LBound(vKYs) To UBound(vKYs) 
       p = 0 
       Do While CBool(InStr(p + 1, .Cells(r, 1).Value2, vKYs(v), vbTextCompare)) 
        p = InStr(p + 1, .Cells(r, 1).Value2, vKYs(v), vbTextCompare) 
        Debug.Print vKYs(v) 
        With .Cells(r, 1).Characters(Start:=p, Length:=Len(vKYs(v))).Font 
         .Bold = True 
         .ColorIndex = 5 
        End With 
       Loop 
      Next v 
     Next r 
    End With 
End Sub 

您可能需要重命名工作表以在5 ^第代碼行進行處理。我還加入了一個幫助程序，用藍色|粗體字標識短語內的關鍵詞。如果不需要，註釋掉或刪除第一個子過程底部的Call key_in_phrase_helper(...)行。

點擊Alt鍵 + Q返回到您的工作表。 Tap Alt + F8打開宏對話框和運行子程序。如果你的數據與我放在一起的樣本數據相似，那麼你應該有類似的結果。

---

¹_{這些都是一些先進的方法，但我覺得他們也是解決問題的最佳途徑。如果您有具體問題，您自己的研究沒有充分解釋，我會嘗試在評論部分解決它們。我爲創建該解決方案而創建的示例工作簿可根據要求提供。}

Answer 2

您可以從第二行開始使用此公式COUNTIF(B:B;"*"&A2&"*")。