刪除行，如果單元格值不在列表

Question

我有2張：在第一次我有日期和在sheet2我有名單列A列。我想從第一張表中刪除列O中沒有名稱的所有行。代碼只是刪除第一張表中的所有內容。歡迎任何幫助。

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中名稱列表相鄰的單元格，如果所述相鄰列中的單元格爲空，則隨後刪除整行。

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 

這不是測試，但它應該像這樣工作。

編輯：我認爲你必須把工作表按正確的順序。我想我把它們混在這裏。