更新:更新:感谢大家最初的贡献,现在我已经通过代码工作,但我卡住了。它给了我一个错误!加上我不确定我的代码是否会做所需的任务。这里是编辑后的描述:=
我有一个客人列表,每个客人都吃某种类型的蔬菜。例如,约翰,史密斯吃土豆和西红柿。而比尔,彼得吃胡萝卜,洋葱。我创建了一个列表,连同关键字,看起来像这样
现在,我收到了一个数据提取,其中包含一个姓名列表以及他们所吃食物的自由文本描述。
不幸的是,我得到的名称格式不符合我的要求,例如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
2条答案
按热度按时间jxct1oxe1#
您可以从以下内容开始:
tgabmvqs2#
还有其他一些事情需要考虑,比如描述列表中只有三个项目,但第一个列表中有4个名称,等等,但这将让你得到大部分的方式: