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

Question

更新：更新：感谢大家最初的贡献，现在我已经完成了代码，但我被困住了。它给了我一个错误！另外，我不确定我的代码是否能完成所需的任务..这是编辑后的描述：=

我有一份客人名单，每个人都吃某种蔬菜。例如约翰·史密斯吃土豆和西红柿。比尔、彼得吃胡萝卜、洋葱。我创建了一个包含关键字的列表，如下所示

现在，我收到一份数据摘录，其中包含姓名列表以及他们所吃食物的自由文本描述。这是我得到的

不幸的是，我得到的名字格式是我不想要的，比如约翰，史密斯（主要客户），我希望 Excel 添加他们吃的蔬菜，因为它写在描述中。例如，John,Smith（主要客户）的描述为：“他吃了炸薯条和薯角”，并且由于该描述包含我的初始表中列出的同一个人的关键字，因此他的名字将从 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

您还需要考虑其他一些事情，例如描述列表中只有 3 个项目，但第一个列表中有 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