通过列表循环遍历列表并删除相同的

我试图在表格4列A（大约100）中查找一系列值，然后使用此列表查看更大的列表（200,000行）在表2列C中出现的每一个值出现在工作表4列A我想检查工作表2列c中的每一行，如果一个值匹配，那么我想删除工作表2中的整个行。通过列表循环遍历列表并删除相同的

I有下面这段代码：

但它似乎没有工作，说有一个对象错误

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

任何帮助都会很棒！

非常感谢

来源

2017-06-29 Ollie

调试你的代码，并提供明确的信息：这是什么错误说哪里（哪一行），它发生。 –

对不起，忘了补充， – Ollie

运行时错误424，需要的对象，第5行 – Ollie

而不必2个For循环，你可以有1 For将通过在列“C”的所有细胞Worksheets("Sheet2")，并为每一行循环，使用Application.Match，看看是否有一个匹配在Worksheets("Sheet4")的列“A”中。

注意：删除行时allways向后循环。

代码

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

来源

2017-06-29 08:44:02

非常感谢，代码工作！它很慢，尽管 – Ollie

是否有加快你知道的，我可以试试吗？ – Ollie

@Ollie我添加了一个小小的麻雀，看看它是否有帮助。 –

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

来源

2017-06-29 09:00:30

通过列表循环遍历列表并删除相同的

回答

相关问题