VBA Excel VLookup

我有以下一组值的第一个工作表

  A栏
 **发件人名称**
 SAAD MAJID SR AL SAAD
 IBRAHIM BIN SABTU ATAU ZULKIFLEE BIN ABDUL RAHMAN
 PUSPA LAL JONES
 RENJA BAHADUR尼泊尔
 RENJA BAHADUR RANGER
 RENJA BAHADUR HAMAL
 PARSHU RAM KARKI

第二个工作表具有以下值

 A栏
 **先生姓名**
琼斯
游侠
棕色
娄宿三
卡尔基

我想在VBA中使用VLookup查找和删除第一个工作表中的数据行，如果第二个表中提到的姓氏显示为全名的一部分。

基本上它会留下以下logging。

 SAAD MAJID SR AL SAAD
 IBRAHIM BIN SABTU ATAU ZULKIFLEE BIN ABDUL RAHMAN
 RENJA BAHADUR尼泊尔 

我已经在VBA中编写了以下代码，但是出现错误。

Dim NameArray() As String Dim result Sub vlookupcode() 'Find last row with data in Column A lastrow = Range("A" & Rows.Count).End(xlUp).row 'Start at bottom and delete rows with errors For myNA = lastrow To 1 Step -1 'If IsError(Cells(myNA, 1)) Then tmp = Cells(myNA, 1).Value 'MsgBox tmp NameArray() = Split(tmp, " ") For i = LBound(NameArray) To UBound(NameArray) 'MsgBox i & " " & NameArray(i) result = Application.VLookup(NameArray(i), Sheet2.Range("A2:A6"), 1, False) If IsError(result) Then MsgBox "Error" Cells(myNA, 1).EntireRow.Delete End If Next Next End Sub 

你能帮我解决这个问题吗？

Answer 1

 Sub vlookupcode() 'Find last row with data in Column A lastrow = Range("A" & Rows.Count).End(xlUp).Row 'the range to which you want to compare Dim comparerng As Range Set comparerng = Sheet2.Range("A2:A6") 'the boolean that stores whether there were occurences Dim result As Boolean 'Start at bottom and delete rows with no matching values in the other set For myNA = lastrow To 1 Step -1 tmp = Cells(myNA, 1).Value 'there are no occurrences until found result = True For Each cell In comparerng.Cells If LCase(tmp) Like "*" & LCase(cell.Value2) & "*" Then result = False 'if there's a match then set the boolean to false Next cell 'if there was no value found then delete If result Then ert = MsgBox("Do you want to delete " & tmp & "?", vbOKCancel) 'if you prompt then why not ask for feedback? If ert = vbOK Then Cells(myNA, 1).EntireRow.Delete End If Next End Sub 

Answer 2

部分匹配最有效的查找可能是通过工作表自带的带通配符的MATCH函数 。

 Sub del_surname() Dim rw As Long, ws1 As Worksheet Set ws1 = Worksheets("Sheet1") With Worksheets("Sheet2") For rw = 2 To .Cells(Rows.Count, 1).End(xlUp).Row If Not IsError(Application.Match(Chr(42) & .Cells(rw, 1) & Chr(42), ws1.Columns(1), 0)) Then ws1.Rows(Application.Match(Chr(42) & .Cells(rw, 1) & Chr(42), ws1.Columns(1), 0)).EntireRow.Delete End If Next rw End With End Sub 

匹配函数将检索通配符查找find其目标的行号。 如果姓氏总是string中的最后一个单词，则可以将Chr(42) & .Cells(rw, 1) & Chr(42)改变为Chr(42) & .Cells(rw, 1) 。

如果多于一个潜在的匹配是可能的，那么重复循环或者使用Range.Find方法和Range.FindNext方法的替代方法将是必要的。