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

gcuhipw9 于 2022-12-01 发布在其他

关注(0)|答案(2)|浏览(200)

更新：更新：感谢大家最初的贡献，现在我已经通过代码工作，但我卡住了。它给了我一个错误！加上我不确定我的代码是否会做所需的任务。这里是编辑后的描述：=
我有一个客人列表，每个客人都吃某种类型的蔬菜。例如，约翰，史密斯吃土豆和西红柿。而比尔，彼得吃胡萝卜，洋葱。我创建了一个列表，连同关键字，看起来像这样

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

不幸的是，我得到的名称格式不符合我的要求，例如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

excel

来源：https://stackoverflow.com/questions/35855435/excel-vba-to-search-for-list-of-keywords-in-a-cell-given-a-value-in-another-cell

2条答案

按热度按时间

jxct1oxe1#

您可以从以下内容开始：

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

赞(0）回复(0）举报 2022-12-01

tgabmvqs2#

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

赞(0）回复(0）举报 2022-12-01

我来回答

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

2条答案

相关问题

热门标签

最新问答