比较Excel中的两列，并从第二个列表中删除第一列中匹配的列

我有两列值，“A”只包含单词，每个单元格一个单词，列“B”包含url，每个单元格一个url。

以下代码在两列之间进行比较，只删除确切的相应值，即“A”在一个单元格中具有“erotic.com”值，而“B”在另一个单元格中具有“erotic.com”（然后在“B “被删除，因为它与”A“的值相符）

如果“A”和“B”之间的任何一个单词匹配，这个代码是否可以修改为比较“A”和“B”并删除“B”的值？ 例如“A”在一个单元格中有“色情”一词，而“B”在另一个单元格中有“erotic.com”url（在“A”中find“B”的值应该被删除为“色情”）？

Option Explicit Function RangeFound(SearchRange As Range, _ Optional ByVal FindWhat As String = "*", _ Optional StartingAfter As Range, _ Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _ Optional LookAtWholeOrPart As XlLookAt = xlPart, _ Optional SearchRowCol As XlSearchOrder = xlByRows, _ Optional SearchUpDn As XlSearchDirection = xlPrevious, _ Optional bMatchCase As Boolean = False) As Range If StartingAfter Is Nothing Then Set StartingAfter = SearchRange(1) End If Set RangeFound = SearchRange.Find(What:=FindWhat, _ After:=StartingAfter, _ LookIn:=LookAtTextOrFormula, _ LookAt:=LookAtWholeOrPart, _ SearchOrder:=SearchRowCol, _ SearchDirection:=SearchUpDn, _ MatchCase:=bMatchCase) End Function Sub ComparePermittedURLS() Dim rngLastCell As Range Dim rngColA As Range Dim rngColB As Range Dim n As Long, j As Long Dim DIC As Object ' Scripting.Dictionary Dim aryColB As Variant Dim aryColA As Variant Dim aryOutput As Variant Dim startTime Dim EndTime startTime = Timer 'On Error GoTo ResetSpeed 'SpeedOn Application.ScreenUpdating = False With Sheets("permitted_urls") '<--Using worksheet's CodeName, or, using tab name-- >ThisWorkbook.Worksheets ("Sheet1") '// Find the last cell in each column, setting a reference to each column's range// '// that contains data. // Set rngLastCell = RangeFound(.Columns(1), , .Cells(1, 1)) If Not rngLastCell Is Nothing Then Set rngColA = .Range(.Cells(1), rngLastCell) Set rngLastCell = RangeFound(.Columns(2), , .Cells(1, 2)) If Not rngLastCell Is Nothing Then Set rngColB = .Range(.Cells(1, 2), rngLastCell) '// In case either column was empty, provide a bailout point. // If rngColA Is Nothing Or rngColB Is Nothing Then MsgBox "No data" Exit Sub End If Set DIC = CreateObject("Scripting.Dictionary") aryColA = rngColA.Value '// fill the keys with unique values from Column A // For n = 1 To UBound(aryColA, 1) DIC.Item(CStr(aryColA(n, 1))) = Empty Next aryColB = rngColB.Value '// Size an output array to the current size of data in Column B, so we can just// '// overwrite the present values. // ReDim aryOutput(1 To UBound(aryColB, 1), 1 To 1) '// Loop through the current values, adding just the values we don't find in // '// the dictionary to out output array. // For n = 1 To UBound(aryColB) If Not DIC.Exists(CStr(aryColB(n, 1))) Then j = j + 1 aryOutput(j, 1) = aryColB(n, 1) End If Next '// Kaplunk. // rngColB.Value = aryOutput Set DIC = Nothing Erase aryColA Erase aryColB Erase aryOutput End With 'ResetSpeed: 'SpeedOff Application.ScreenUpdating = True EndTime = Timer MsgBox "Total Time: " & EndTime - startTime End Sub 

Answer 1

 Sub ComparePermittedURLS() Dim rngDel As Range Dim rngFound As Range Dim varWord As Variant Dim strFirst As String With Sheets("permitted_urls") For Each varWord In Application.Transpose(.Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).Value) If Len(varWord) > 0 Then Set rngFound = .Columns("B").Find(varWord, .Cells(.Rows.Count, "B"), xlValues, xlPart) If Not rngFound Is Nothing Then strFirst = rngFound.Address Do If Not rngDel Is Nothing Then Set rngDel = Union(rngDel, rngFound) Else Set rngDel = rngFound Set rngFound = .Columns("B").Find(varWord, rngFound, xlValues, xlPart) Loop While rngFound.Address <> strFirst End If End If Next varWord End With If Not rngDel Is Nothing Then rngDel.Delete Set rngDel = Nothing Set rngFound = Nothing End Sub