代码在行'**ERROR HERE
我打开了几个名称是动态的工作簿,每个工作簿都有一个名为“CC”的工作表。我想比较D列的值与所有打开的工作簿中“CC”工作表中的工作簿名称,如果该工作簿名称不等于工作表CC的列D值,则从工作表CC中删除这些行。
Sub filter()
Dim wbs As Workbooks
Dim wb As Workbook
Set wbs = Application.Workbooks
For Each wb In wbs
For j = lastRowy(Worksheets("CC")) To 1 Step -1
If wb.Name <> wb.Worksheets("CC").Cells(j, "D").Value Then '**ERROR HERE
Rows(j).Delete
End If
Next j
Next wb
End Sub
Function lastRowy(sh As Worksheet)
On Error Resume Next
lastRowy = sh.Cells.Find(what:="*", _
After:=sh.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
答案 0 :(得分:1)
试试这个。我已确保您的参考资料完全合格,并且还有一些补充逻辑,请参阅评论以获取详细信息。
Sub filter()
Dim wb As Workbook
Dim ws As Worksheet
Dim lastRow As Long
For Each wb In Application.Workbooks
Set ws = wb.Worksheets("CC")
If Not ws Is Nothing Then 'check that worksheet exists
lastRow = lastRowy(ws)
If lastRow > 1 Then 'check that sheet has more than just headers
For j = lastRow To 2 Step -1
If wb.Name <> ws.Cells(j, "D").Value Then
ws.Rows(j).Delete
End If
Next j
End If
End If
Next wb
End Sub
Function lastRowy(sh As Worksheet) As Long
Dim rng As Range
Set rng = sh.Cells.Find(what:="*", _
After:=sh.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
If rng Is Nothing Then Exit Sub 'if Find didn't find anything then it would have returned rng = Nothing
lastRowy = rng.Row
End Function