计算并突出显示短语中的关键字

我有一个两列的Excel表。 第一列是关键短语，第二列是消息。 关键短语可能出现在消息列中。 我需要知道消息列中出现了多less次关键短语。 请build议一些好的和简单的方法find。

关键短语是一列，消息是第二列。 消息列是1个或多个关键短语的组合（连接）。 我需要找出每条消息包含多less关键短语。

Answer 1

有可能你可以用一个模块子过程来收集一个有效的计数，这个子程序执行存储器arrays中所有的math运算并将计数返回到工作表。

我使用了一些标准的Lorem Ipsum关键字和短语来创build上面的示例数据。

点击Alt + F11 ，当VBE打开时，立即使用下拉菜单来插入►模块（ Alt + I ， M ）。 将以下代码粘贴到名为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 ^个代码行中处理。 我还join了一个帮助程序，用蓝色|粗体字标识词组中的关键词。 如果Call key_in_phrase_helper(...)注释掉或删除第一个子过程底部的Call key_in_phrase_helper(...)行。

点击Alt + Q返回到您的工作表。 点击Alt + F8打开macros对话框并运行子程序。 如果你的数据类似于我放在一起的样本数据，那么你应该有类似的结果。

---

¹ _{这些是一些先进的方法，但我觉得它们也是解决问题的最好方法。 如果你有自己的研究没有充分解释的具体问题 ，我会尝试在评论部分解决它们。 我为创build此解决scheme而创build的示例工作簿可根据要求提供。}

Answer 2

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