Vba 循环浏览一个列表并与另一个列表进行比较,如果相同,则删除

Vba 循环浏览一个列表并与另一个列表进行比较,如果相同,则删除,vba,excel,Vba,Excel,我试图查找第4页a列中的一系列值(大约有100个),然后使用此列表查看第2页C列中更大的列表(200000行)。对于第4页a列中出现的每个值,我想检查第2页C列中的每一行,如果值匹配,我想删除第2页中的整行 我有以下代码: 但它似乎不起作用,他说有一个对象错误 Option Explicit Sub Test() Dim rng As Range Dim I As Long, J As Integer Dim myCell As Range Set rng = Worksheets("Shee

我试图查找第4页a列中的一系列值(大约有100个),然后使用此列表查看第2页C列中更大的列表(200000行)。对于第4页a列中出现的每个值,我想检查第2页C列中的每一行,如果值匹配,我想删除第2页中的整行

我有以下代码:

但它似乎不起作用,他说有一个对象错误

Option Explicit

Sub Test()
Dim rng As Range
Dim I As Long, J As Integer
Dim myCell As Range
Set rng = Worksheets("Sheet4").["A1:A" & Range("A" & 
Rows.Count).End(xlUp).Row)"]
With rng
For I = .Rows.Count To 1 Step -1
For J = 1 To .Columns.Count
For Each myCell In Worksheets("Sheet2").Range("C1:C" & Range("C" & 
Rows.Count).End(xlUp).Row)
If .Cells(I, J).Value = myCell Then
.Cells(I, J).EntireRow.Delete xlUp
Exit For
End If
Next
Next J
Next I
End With
Set rng = Nothing
End Sub
任何帮助都会很好


非常感谢

不要让2个
For
循环,你可以让1个
For
循环通过
工作表(“Sheet2”)
中“C”列中的所有单元格,对于每一行,使用
应用程序。Match
查看
工作表(“Sheet4”)中的“a”列中是否有匹配项

注意:删除行时始终向后循环

代码


与2个
For
循环不同,您可以让1个
For
循环通过
工作表(“Sheet2”)
中“C”列中的所有单元格,对于每一行,使用
应用程序。Match
查看
工作表(“Sheet4”)
中的“a”列中是否有匹配项

注意:删除行时始终向后循环

代码


调试您的代码并提供清晰的信息:错误说明了什么以及发生在哪里(哪一行)。很抱歉,忘了在运行时错误424中添加该信息,需要对象,第5行。您的第5行没有任何意义。VBA中没有用于索引的方括号,而且
对象。[…]
不是有效的构造。请尝试以下操作:
Set rng=Worksheets(“Sheet4”).Range(“A1:A”和Range(“A”和Rows.Count”).End(xlUp.Row)
将第5行更改为
Set rng=Worksheets(“Sheet4”).Range(“A1:A”和Range(“A”和Rows.Count”).End(xlUp.Row)
调试代码并提供清晰的信息:错误说明了什么以及在哪里(哪一行)很抱歉忘了在运行时错误424中添加,需要对象,第5行。您的第5行没有任何意义。VBA中没有用于索引的方括号,而且
对象。[…]
不是有效的构造。试试这个:
Set-rng=Worksheets(“Sheet4”).Range(“A1:A”和Range(“A”和Rows.Count”).End(xlUp.Row)
将第5行改为
Set-rng=Worksheets(“Sheet4”).Range(“A1:A”和Range(“A”和Rows.Count”).End(xlUp.Row)
你知道有没有加快速度的方法,我可以试试吗?@Ollie我添加了一个小技巧,看看是否有帮助。你知道有没有加快速度的方法,我可以试试吗?@Ollie我加了一个小东西,看看是否有帮助。
Option Explicit

Sub Test()

Dim Rng As Range
Dim i As Long
Dim LastRow As Long

' set up Matched Range
Set Rng = Worksheets("Sheet4").Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
Application.ScreenUpdating = False
With Worksheets("Sheet2")
    ' get last row in column C
    LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row

    ' allways loop backwards when deleting rows
    For i = LastRow To 1 Step -1
        ' check if successful match 
        If Not IsError(Application.Match(.Range("C" & i).Value, Rng, 0)) Then
            .Rows(i).Delete
        End If
    Next i    
End With
Application.ScreenUpdating = True

End Sub
You can use ADODB within the macro which can give you the result in seconds

Sub Filter()

Dim con As New ADODB.Connection

Dim rs As New ADODB.Recordset

Dim DBPath As String, sconnect As String

DBPath = ThisWorkbook.FullName  'Refering the sameworkbook as Data Source

'You can provide the full path of your external file as shown below
'DBPath ="C:\InputData.xlsx"

sconnect = "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & DBPath & ";HDR=Yes';"

'If any issue with MSDASQL Provider, Try the Microsoft.Jet.OLEDB:
'sconnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DBPath _
& ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"

con.Open sconnect

sSQLSting = "SELECT * From [Sheet2$] WHERE ColC not in (SELECT ColA FROM [Sheet1$])" ' Your SQL Statement (Table Name= Sheet Name=[Sheet1$])

rs.Open sSQLSting, con

Sheet3.Range("A2").CopyFromRecordset rs

End Sub



NOTE : In the Excel Code editor go to TOOLS->References and set a reference to Microsoft ActiveX Data Objects 6.1 Library