Excel VBA搜索单元格中的关键字列表，并在另一个单元格中给出值，然后对第三个单元格进行更改

Question

更新：更新：感谢大家的最初贡献，现在我已经完成了代码，但是我卡住。它给了我一个错误！加上我不知道我的代码是否会完成所需的任务..这里是编辑过的描述：=

我有一个列表，每个人都吃某种类型的蔬菜。例如，约翰史密斯吃土豆和番茄。比尔，彼得吃红萝卜，洋葱。我已创建了关键字沿着列表，看起来像这样

现在，我收到了名字与他们吃食物的自由文本描述沿列表的数据提取。以下是我得到

不幸的是，我得到的是我不希望像约翰·史密斯（主要客户）的格式的名称，我想练成添加的蔬菜他们吃的给它写在描述中。例如，约翰·史密斯（主要客户）的描述如下：“他有炸薯条和楔子”，并且由于描述中包含的关键字列在我的初始表中，对于同一个人，他的名字将从John，Smith（主要客户）转交给John，Smith-Potato（主要客户）。

我想要excel来检查名称是否存在于第一个表中，然后查看描述以找到任何关键字。这将确保如果名称不在我的列表中，那么Excel不会花时间寻找关键字。另外，如果没有找到关键字，那么不要编辑名称。

这是我希望得到

有了你们，我能够编辑该代码的帮助，但它仍然给我的错误，我不知道，如果它做什么，我想它要做的。任何想法从哪里去？

这里是代码：

Option Explicit 
Sub homework() 
Dim ws1 As Worksheet, ws2 As Worksheet, keywords() As String, lastRow As Integer, lastRow2 As Integer, c As Variant, x As Integer, y As Integer, k As Variant, cel As Range, descript As Range 
Dim SrchRng As Range 
Dim SrchStr As Variant 
Set ws1 = Worksheets("Sheet2") 'the sheet that contains keywords which is the sheet i will make 
Set ws2 = Worksheets("Sheet1") 'the sheet that contains description of food 
lastRow = ws1.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, searchdirection:=xlPrevious).Row 
lastRow2 = ws2.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, searchdirection:=xlPrevious).Row 
Set SrchRng = Worksheets("Sheet2").Range("A1:A1000") 
Set descript = ws2.Range("C2:C" & lastRow2) 
For x = 2 To lastRow ' this is to the last row in the database i will create 
    keywords = Split(ws1.Cells(x, 3), ",") 
    For Each k In keywords 
     For Each cel In descript 
     For y = 2 To lastRow2 
     Do 
     SrchStr = Left(ws2.Cells(y, 2), InStr(ws2.Cells(y, 2), " (") - 1) 
     Set c = SrchRng.Find(SrchStr, LookIn:=xlValues) 
      If Not SrchRng.Find(SrchStr, LookIn:=xlValues) Is Nothing And InStr(ws2.Cells(y, 3), k) <> 0 Then 
       ws2.Cells(y, 2).Value = ws1.Cells(x, 1).Value & "-" & ws1.Cells(x, 2).Value 
       SrchStr = Nothing 
       Exit Do 
       End If 
     Loop While Not c Is Nothing 
      Next y 
     Next cel 
    Next k 
Next x 
End Sub 

Answer 1

你可以用这个启动：

Sub test() 

    Dim name As String   ' user name 
    Dim vegetables() As String ' available vegetables 
    Dim v As Variant   ' item in vegetables 
    Dim sentence As String  ' the text to search 

    name = "John,Smith" 
    vegetables() = Split("fries, potato, mashed", ", ") 
    sentence = "he had french fries and wedges" 
    For Each v In vegetables 
     ' if sentence contains the keyword v 
     If InStr(sentence, v) <> 0 Then 
      Debug.Print "John,Smith" & "-" & v 
     End If 
    Next v 

End Sub 

Answer 2

有你需要考虑其他的东西，比如有在描述中只有三个项目列表，但第一个列表中的4个名字等，但是这将使您获得大部分途径：

Option Explicit 
    Sub homework() 
    Dim ws1 As Worksheet, ws2 As Worksheet, keywords() As String, lastRow As Integer, lastRow2 As Integer, x As Integer, k As Variant, cel As Range, descript As Range 
    Set ws1 = Worksheets("Sheet1") 
    Set ws2 = Worksheets("Sheet2") 
    lastRow = ws1.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 
    lastRow2 = ws2.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 
    Set descript = ws2.Range("B2:B" & lastRow2) 
    For x = 2 To lastRow 
     keywords = Split(ws1.Cells(x, 3), ",") 
     For Each k In keywords 
      For Each cel In descript 
       If InStr(ws2.Cells(x, 2), k) <> 0 Then 
        ws1.Cells(x, 4).Value = ws1.Cells(x, 1).Value & "-" & ws1.Cells(x, 2).Value 
       End If 
      Next cel 
     Next k 
    Next x 
    End Sub