将标题分隔成单词并在标题中search

我正在试图自动化一个Excel文件，这个文件在A列和B列都有标题，我必须从B中searchA中的每个单词。如果任何单词匹配，那么我需要将它粘贴在可用的C列（C，D， …）在同一行。

我正在使用下面的代码，我将手动分离单词列A标题中的单词，并在列B中search：

Sub macro1() Application.ScreenUpdating = False Dim col As Range, cell1 As Range, a As String, b As String, i As Integer Set col = Range("KW[KW1]") Dim target, cell As Range Sheets("Data").Select Set target = Range(Range("B1"), Range("B65536").End(xlUp)) Dim term, tag As String For Each cell1 In col a = cell1.Value term = a tag = a For Each cell In target b = cell.Value If Module1.ExactWordInString(b, a) Then For i = 1 To 15 If cell.Offset(0, i).Value = "" Then cell.Offset(0, i).Value = tag Exit For End If Next i End If Next cell Next cell1 Application.ScreenUpdating = True End Sub 

我期待输出：

 Column A Column B Column C Column D Title 1 Title 2 XXX YYY zzz aaa asdbfjk XXX yyy sfkbvskdf XXX yyy 

显然它花了这么多时间，有谁能帮我一下吗？

Answer 1

基于已经讨论过的内容，并基于MathewDbuild议的使用分割函数。 我将每个细胞分成一个数组，然后通过这些数组循环查找匹配，然后把这些匹配在各个单元格中使用偏移量和计数器移动到下一列。 喜欢这个：

 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("KW1"), Range("KW1").End(xlDown)) For Each cel In aRng a = Split(cel, " ") b = Split(cel.Offset(, 1), " ") clm = 2 For i = LBound(a) To UBound(a) For t = LBound(b) To UBound(b) If a(i) = b(t) And a(i) <> "" Then cel.Offset(, clm) = a(i) clm = clm + 1 End If Next Next Next 

这是大小写敏感的，如果你不想大小写敏感，那么改变if语句就可以了

If UCase(a(i)) = UCase(b(t)) And a(i) <> "" Then