Vba循环遍历所有打开的工作簿并将这些工作簿名称与一些值进行比较并执行一些操作

Posted 2023-04-13

【中文标题】Vba循环遍历所有打开的工作簿并将这些工作簿名称与一些值进行比较并执行一些操作

【英文标题】：Vba loop through all open workbook and comparing those workbook name with some value and do some operations

【发布时间】：2018-01-04 09:16:44

【问题描述】：

代码在'**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

【问题讨论】：

您收到的错误信息是什么？此外，您还没有在此处限定工作表参考：lastRowy(Worksheets("CC"))。将其更改为lastRowy(wb.Worksheets("CC"))

我已经这样做了，但它给了我运行时错误 9 下标超出范围

所以您可能打开了一个没有“CC”工作表的工作簿？

谢谢，现在错误已被删除，但代码没有给出任何输出。输出应该是从 CC 工作表中删除所有工作簿的所有行，其中 D 列的值与各自的文件名不同

【参考方案1】：

试试这个。我已确保您的参考文献是完全合格的，并且还添加了一些逻辑，请参阅 cmets 了解详细信息。

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

【讨论】：

谢谢，只有一件事不想删除标题行意味着第 1 行，所以我如何从比较中排除第 1 行

@yashikavaish 已更新。只需编辑 If lastRow... 和 For j = lastRow... 行以排除第 1 行