我有一份客人名单,每个客人都吃某种蔬菜。例如约翰,史密斯吃土豆和西红柿。比尔,彼得吃胡萝卜,洋葱。我创建了一个列表以及看起来像这样的关键字
现在,我收到一个数据提取,其中包含名称列表以及他们所吃食物的自由文本描述。这是我得到的
不幸的是,我以我不想要的格式获得名称,例如 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