vba - 如果存在值查找，则excel vba查找关键字列表，然后编辑另一个单元格的值

Question

我有一份客人名单，每个客人都吃某种蔬菜。例如约翰，史密斯吃土 bean 和西红柿。比尔，彼得吃胡萝卜，洋葱。我创建了一个列表以及看起来像这样的关键字



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



不幸的是，我以我不想要的格式获得名称，例如 John，Smith(主要客户)，并且我希望 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

我认为按照下面的方式可以工作，更改范围以满足您的需要，但它会根据列表 1st 检查 guest 名称，然后将关键字分配给数组并检查它们。

Sub example1()
Dim WS1 As Worksheet, WS2 As Worksheet
Dim GuestName() As Variant, Keywords As Variant
Dim GNi As Integer, Ri As Integer, KWi As Integer

Set WS1 = Worksheets("Sheet2")
Set WS2 = Worksheets("Sheet1")

With WS1
  GuestName = .Range("A2:A" & .Cells.SpecialCells(xlCellTypeLastCell).Row)
End With

With WS2
  For Ri = 2 To .Cells.SpecialCells(xlCellTypeLastCell).Row 'starting at the 2nd row to the last row with data on the sheet
    For GNi = 1 To UBound(GuestName)
      If InStr(1, .Range("B" & Ri), GuestName(GNi, 1)) > 0 Then 'searches for the guestname to match against
        Keywords = WS1.Range("C" & GNi + 1) 'assigns the keywords matching the guestname
        Keywords = Split(Keywords, ",")
        For KWi = 0 To UBound(Keywords)
          If InStr(1, .Range("C" & Ri), Keywords(KWi)) > 0 Then
            'found keyword
          End If
        Next
      End If
    Next
  Next
End With
End Sub