使用列中的字符串在表中查找匹配的单词以赋值 [英] Use string in column to find a word match in table to assign value

问题描述

我在Sheet1中有一个数据查找表，其中列A和列B中的所有名称都将是唯一的，因此任何一个A中的名称都不会存在于B中，反之亦然。但是，某些名称可以包含特殊字符，如连字符或破折号，如O‘Neil或Jamie-Lee

我在Sheet2中有另一个数据表，其中我需要使用列D中的文本字符串在Sheet1中(在A列或B列中)查找匹配的名称，如果在Sheet2列E中找到匹配项，则将Sheet1上的行的分值赋值。

我已在E列中输入匹配的分数值，以演示我需要的结果。 我不介意使用适用于XL2010的VBA或Excel公式

是否可以使用文本字符串来查找匹配的单词，因为我只看到了相反的情况，或者我看错了吗？我就是好像什么都没拿到。

我现在经常更改代码，试图让它正常工作，我想我有点迷路了，但这是我代码不工作的当前状态：

Sub TextSearch()

    Dim LR As Long
        LR = ThisWorkbook.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row

    Dim xLR As Long
        xLR = ThisWorkbook.Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row

    
    Dim oSht As Worksheet
    Dim Lastrow As Long
    Dim strSearch As String, Score As String
    Dim aCell As Range
    Dim i As Integer
    
    Set oSht = Sheets("Sheet1")
    Lastrow = oSht.Range("A" & Rows.Count).End(xlUp).Row
    
        
    With Sheets("Sheet2")
        'Loop from Lastrow to Firstrow (bottom to top)
        For Lrow = xLR To 2 Step -1
            'Get the value in the D column to perform search on
            With .Cells(Lrow, "D")
                If Not IsEmpty(.Value) Then
                    strSearch = .Value
                
                    Set aCell = oSht.Range("A1:B" & Lastrow).Find(What:=strSearch, LookIn:=xlValues, _
                                    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                    MatchCase:=False, SearchFormat:=False)

                    For i = 2 To Lastrow
                        'Lookin column A on sheet1
                        If oSht.Cells(i, 1).Value = aCell Then
                            Score = oSht.Cells(i, 1).Offset(0, 2).Value
                            Sheets("Sheet2").Cells(Lrow, 4).Offset(0, 1).Value = Score
                        'Lookin Column B on sheet1
                        ElseIf oSht.Cells(i, 2).Value = aCell Then
                            Score = oSht.Cells(i, 2).Offset(0, 1).Value
                            Sheets("Sheet2").Cells(Lrow, 4).Offset(0, 1).Value = Score
                        End If
                    Next i
                
                
                End If
            End With
        Next Lrow
    End With

End Sub

推荐答案

这应该执行您正在尝试使用字典的操作。它根据工作表1上的列A和B创建关键字，并将它们的分数存储为项目。

如果您在表1中有重复的名称，这不会失败，但它将只与遇到的第一个名称匹配。数据不足，无法进行我可以看到的区分。

Sub findmatches()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim dict As Object
    Dim i As Long
    Dim lr As Long
    Dim name As String
    
    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")
    Set dict = CreateObject("Scripting.Dictionary")
    
    With ws1
        lr = .Cells(.Rows.Count, 1).End(xlUp).Row 'Getting last row
        For i = 2 To lr
            If Not dict.exists(.Cells(i, 1).Value) Then 'Checking if name is in dictionary
                dict.Add .Cells(i, 1).Value, .Cells(i, 3).Value 'Adding name and score
            End If
            If Not dict.exists(.Cells(i, 2).Value) Then 'Checking if name is in dictionary
                dict.Add .Cells(i, 2).Value, .Cells(i, 3).Value 'Adding name and score
            End If
        Next i
    End With
    
    With ws2
        lr = .Cells(.Rows.Count, 4).End(xlUp).Row
        For i = 2 To lr
            name = Split(.Cells(i, 4).Value, " ")(0) 'Splitting the string into an array and taking the first element
            If dict.exists(name) Then 'Checking if name is in dict
                .Cells(i, 5).Value = dict(name) 'assigning score to Column 5
            Else
                .Cells(i, 5).Value = 0 'No name score = 0
            End If
        Next i
    End With
End Sub

这篇关于使用列中的字符串在表中查找匹配的单词以赋值的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！