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