[英]Excel VBA to search for list of keywords in a cell given a value in another cell and then make changes to a third cell
更新:更新:感谢大家的最初贡献,现在我已经完成了代码,但我被卡住了。 它给了我一个错误! 另外我不确定我的代码是否会完成所需的任务..这是编辑后的描述:=
我有一份客人名单,每个客人都吃某种类型的蔬菜。 例如约翰、史密斯吃土豆和西红柿。 比尔、彼得吃胡萝卜、洋葱。 我已经创建了一个列表以及看起来像这样的关键字
现在,我收到了一个数据摘录,其中包含一个名称列表以及他们所吃食物的自由文本描述。 这是我得到的
不幸的是,我以我不想要的格式获取名称,例如 John,Smith(主要客户),我希望 excel 添加他们吃的蔬菜,因为它写在描述中。 例如,John,Smith(主要客户)的描述为:“he had French fries and wedges”,并且由于描述包含在我的初始表中为同一个人列出的关键字,那么他的名字将从 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
你可以从这个开始:
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
您还需要考虑其他事项,例如描述列表中只有三个项目,但第一个列表中有 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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.