如果单元格值不在列表中，则删除行

我有2张：在第一次我有date和sheet2我有名单列A中。 我想从第一张表中删除列O中sheet2中没有名称的所有行。 代码只是删除第一张表中的所有内容。 欢迎任何帮助。

Sub Demo() Dim Rng As Range, List As Object, Rw As Long Dim x As Date x = Now() Set List = CreateObject("Scripting.Dictionary") With Sheets("Sheet2") For Each Rng In .Range("A1", .Range("A" & Rows.Count).End(xlUp)) If Not List.Exists(Rng.Value) Then List.Add Rng.Value, Nothing End If Next End With With Sheets("query " & Format(x, "dd.mm.yyyy")) For Rw = .Range("O" & Rows.Count).End(xlUp).Row To 1 Step -1 If Not List.Exists(.Cells(Rw, "O").Value) Then .Rows(Rw).Delete End If Next End With Set List = Nothing End Sub 

Answer 1

我不确定这是否完全符合你的要求，但它确实是非常相似的。 要清楚：

标记Sheet1中名称列表旁边的单元格，如果find该名称，则在所述相邻列中的单元格为空时，随后删除整行。

 Sub Macro() Dim r As Long Dim r2 As Long Dim counter As Long Dim counter2 As Long Range("O1").Select Selection.End(xlDown).Select r = ActiveCell.Row Sheets(ActiveSheet.Index + 1).Select Range("A1").Select Selection.End(xlDown).Select r2 = ActiveCell.Row Range("A1").Select For counter = 1 To r2 needle = ActiveCell.Value Sheets(ActiveSheet.Index - 1).Select On Error GoTo NotFound Range(Cells(1, 15), Cells(r, 15)).Find(needle).Select Selection.Offset(0, 1).Value = "found" NotFound: Sheets(ActiveSheet.Index + 1).Select Selection.Offset(1, 0).Select Next Sheets(ActiveSheet.Index - 1).Select Range("P1").Select For counter2 = 1 To r If ActiveCell.Value = "" Then Selection.EntireRow.Delete Selection.Offset(1, 0).Select Next Cleanup: Range("P1:P10000").Value = "" End Sub 

然而，这是相当丑陋和低效率的代码。 如果有什么需要改变的话

Answer 2

我会这样做：

 Dim i as integer dim x as integer Dim rngSearch as Range Dim strName as String Dim ws1 as Worksheet dim ws2 as Worksheet Set ws1 = Thisworkbook.worksheets(1) Set ws2 = Thisworkbook.worksheets(2) x = ws1.cells(ws1.rows.count,1).end(xlup).row for i = 2 to x strName = ws1.cells(i, 1) set rngSearch = ws2.columns(15).find(strName) if rngSeach is nothing then ws1.rows(i).entirerow.delete i = i-1 end if next i 

它没有testing，但它应该像这样工作。

编辑：我认为你必须把工作表按正确的顺序。 我想我把他们混在这里。