VBA Split + Vlookup 为产品名称自动生成关键字

求助一个关于VBA的问题，我有一页产品名称的列表，我还有一页都是关键词，我想写个macro可以浏览我每个产品名称中的每一个词，去关键字页中查找是否有对应的关键词，用这种方法为产品名称生成关键字 附件中的workbook里有两个worksheet，一个worksheet存有产品名称【title】，另一个worksheet存有名称中部分单词对应的关键字（ 类似于字典）【dictionary】 我希望写一个macro，可以把 title sheet 中每一行中的每一个词去dictionary sheet 查找看是否存在对应的关键词，如果有对应，则记录下来，当长度累计到100 character时 显示到title sheet 的 search term1 中，当多于100个时，多出的显示到search term 2 中 举例来说：title sheet 中A2 是 Pocketed Button Up shirts， 当运行macro时，把这个title中的每一个词在dictionary 的 Keyword 列中寻找是否有一样的词。Dictionarysheet中A6是pockets, 符合要求，因此把B6 中所有的词复制到title sheet中B2 cell中，然后继续寻找第二个词“ Button” ， 发现 ictionarysheet中A9是button，因此把B9 中所有的词复制到title sheet中B2 cell中.如此反复，直到搜索完title中所有的词。如果B2的长度超过100个词，就放到C2中。 简化的excel表在附件中。 我刚刚起步就碰到了问题，我想先建立两个数组，一个存title，一个存split后的每个词，但是总是出错。 Sub savetitle() Application.ScreenUpdating = False Dim title() Dim i As Integer Dim j As Integer Dim searchterm() Dim lngLastRow As Long Set MyRange = Worksheets("title").Range("A" & "2") lngLastRow = Cells(65553, MyRange.Column).End(xlUp).Row For i = 1 To lngLastRow title(i) = ActiveSheet.Range("A" & "2").Cells(i, 1).Text searchterm(j) = Split(title(i), "") For j = 0 To UBound(searchterm(i)) Cells(i, 2).Value = searchterm(j) Next j Next i End Sub 如果有高人能够一次性帮我解决所有的问题并告诉我我写的哪里错了，奖励25个论坛币。请务必写注释。 多谢多谢

可能点错了，就变成绿色了。文字部分如下：

求助一个关于VBA的问题，我有一页产品名称的列表，我还有一页都是关键词，我想写个macro可以浏览我每个产品名称中的每一个词，去关键字页中查找是否有对应的关键词，用这种方法为产品名称生成关键字


附件中的workbook里有两个worksheet，一个worksheet存有产品名称【title】，另一个worksheet存有名称中部分单词对应的关键字（ 类似于字典）【dictionary】

我希望写一个macro，可以把 title sheet 中每一行中的每一个词去dictionary sheet 查找看是否存在对应的关键词，如果有对应，则记录下来，当长度累计到100 character时 显示到title sheet 的 search term1 中，当多于100个时，多出的显示到search term 2 中

举例来说：title sheet 中A2 是 Pocketed Button Up shirts， 当运行macro时，把这个title中的每一个词在dictionary 的 Keyword 列中寻找是否有一样的词。Dictionarysheet中A6是pockets, 符合要求，因此把B6 中所有的词复制到title sheet中B2 cell中，然后继续寻找第二个词“ Button” ， 发现
ictionarysheet中A9是button，因此把B9 中所有的词复制到title sheet中B2 cell中.如此反复，直到搜索完title中所有的词。如果B2的长度超过100个词，就放到C2中。

简化的excel表在附件中。


我刚刚起步就碰到了问题，我想先建立两个数组，一个存title，一个存split后的每个词，但是总是出错。

Sub savetitle()
Application.ScreenUpdating = False
Dim title()
Dim i As Integer
Dim j As Integer
Dim searchterm()
Dim lngLastRow As Long
Set MyRange = Worksheets("title").Range("A" & "2")
lngLastRow = Cells(65553, MyRange.Column).End(xlUp).Row
For i = 1 To lngLastRow
title(i) = ActiveSheet.Range("A" & "2").Cells(i, 1).Text
searchterm(j) = Split(title(i), "")
For j = 0 To UBound(searchterm(i))
Cells(i, 2).Value = searchterm(j)
Next j
Next i
End Sub




如果有高人能够一次性帮我解决所有的问题并告诉我我写的哪里错了，奖励25个论坛币。请务必写注释。

多谢多谢