VBA Excel查找工作表名称，如果“选项卡”已“开始”，则循环浏览这些工作表

Question

我的VBA脚本中有一个函数，该函数当前循环遍历所有数字表名称并执行一个函数。 001、002、003等

我希望对此进行改进，以便仅查看标记为“开始”的工作表名称。 我在同一工作簿中有一个名为“初始索引”的工作表，其中在第1列（A）中列出了工作表编号（带有超链接，希望这不会造成问题），在同一表中有一个“状态”列5 （E）每张纸都包含“开始”，“想法”，“持有”。

然后，VBA脚本继续将信息中的某些位从相关选项卡复制并粘贴到称为操作摘要的新表中。

我希望仅替换下面的代码部分即可完成此操作。 有任何想法吗？

 'Loop through all sheets in the workbook
For Each ws In wb.Sheets
    'Only look for worksheets whose names are numbers (e.g. "001", "002", etc)
    If IsNumeric(ws.Name) Then

更新：对于上下文，完整代码在这里：

    Sub UpDate_List_v2()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim wsSum As Worksheet
    Dim rLastCell As Range
    Dim lCalc As XlCalculation
    Dim bHasHeaders As Boolean


    'Turn off calculation, events, and screenupdating
    'This allows the code to run faster and prevents "screen flickering"
    With Application
        lCalc = .Calculation
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set wb = ActiveWorkbook

    'Check if Actions Summary sheet exists already or not
    On Error Resume Next
    Set wsSum = wb.Sheets("Actions summary")
    On Error GoTo 0

    If wsSum Is Nothing Then
        'Does not exist, create it
        Set wsSum = wb.Sheets.Add(Before:=wb.Sheets(1))
        wsSum.Name = "Actions summary"
        bHasHeaders = False
    Else
        'Already exists, clear previous data
        wsSum.UsedRange.Offset(1).Clear
        bHasHeaders = True
    End If

    'Loop through all sheets in the workbook
    For Each ws In wb.Sheets
        'Only look for worksheets whose names are numbers (e.g. "001", "002",       etc)
 '-----------------------------------
    If IsNumeric(ws.Name) Then
                l = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
                For i = 1 To l
                    If ActiveWorkbook.Worksheets("Initiative Index").Range("A" & i).Value = ws.Name And ActiveWorkbook.Worksheets("Initiative Index").Range("E" & i).Value <> "Started" Then Exit If
    '--------------------------------------
            'Check if the "Actions Summary" sheet already has headers
            If bHasHeaders = False Then
                'Does not have headers yet
                With ws.Range("A8:M8")
                    'Check if this sheet has headers in A8:G8
                    If WorksheetFunction.CountBlank(.Cells) = 0 Then
                        'This sheet does have headers, copy them over
                        .Copy wsSum.Range("A1")
                        bHasHeaders = True
                    End If
                End With
            End If

            'Find the last row of the sheet
            Set rLastCell = ws.Cells.Find("*", ws.Range("A1"), SearchDirection:=xlPrevious)
            If Not rLastCell Is Nothing Then
                'Check if the last row is greater than the header row
                If rLastCell.Row > 8 Then
                    'Last row is greater than the header row so there is data
                                    'Check if the "Actions Summary" sheet has enough rows to hold the data
                                    If wsSum.Cells(wsSum.Rows.Count, "A").End(xlUp).Row + rLastCell.Row - 8 > wsSum.Rows.Count Then
                                        'Not enough rows, return error and exit the subroutine
                                        MsgBox "There are not enough rows in the summary worksheet to place the data.", , "Data Overflow"
                                        Exit Sub
                                    Else
                        'Does have enough rows, copy the data - Values
                        ws.Range("A9:M" & rLastCell.Row).Copy
                        With wsSum.Cells(wsSum.Rows.Count, "A").End(xlUp).Offset(1)
                            .PasteSpecial xlPasteValues
                            .PasteSpecial xlPasteFormats
                        End With
                    End If
                End If
            End If
           Next   'here
        End If
    Next ws

        'Sheets("Actions summary").Columns("H:L").EntireColumn.Delete       'Delete unwanted columns
        'Sheets("Actions summary").Columns("H:L").Hidden = True              'Hide unwanted columns
        Worksheets("Actions summary").Columns("H").Hidden = True
        Worksheets("Actions summary").Columns("J").Hidden = True
        Worksheets("Actions summary").Columns("L").Hidden = True
        Sheets("Actions summary").Columns("H").Style = "currency"           'Set to £

    Application.CutCopyMode = False                         'Remove the cut/copy border
    'wsSum.Range("A1").CurrentRegion.EntireColumn.AutoFit    'Autofit columns on the "Actions Summary" sheet

    'Turn calculation, events, and screenupdating back on
    With Application
        '.Calculation = lCalc
        Application.Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .ScreenUpdating = True
    End With

End Sub

Answer 1

If IsNumeric(ws.Name) Then
    l = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
    For i = 1 To l
        If ActiveWorkbook.Worksheets("Initiative Index").Range("A" & i).Value = ws.Name And ActiveWorkbook.Worksheets("Initiative Index").Range("E" & i).Value = "Started" Then
            'run code
        Else
            Exit If
        End If
    Next
End If

也许这可以帮助您。 该代码首先检查您分配的值(001)是否在Initiative Index中指定的列表中。 它还检查E列中的值是否等于Started 。 如果是这样，您将能够运行所需的代码。 如果不是，则可以退出If语句，并且不运行代码。

更新1：您也可以尝试下面的代码，用这种方法，您必须用-----之间的所有内容替换建议的代码， next必须放在这里：

          End If
        Next   'here 
    End If
Next ws

编码：

   '-----------------------------------        
    If IsNumeric(ws.Name) Then
                l = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
                For i = 1 To l
                    If ActiveWorkbook.Worksheets("Initiative Index").Range("A" & i).Value = ws.Name And ActiveWorkbook.Worksheets("Initiative Index").Range("E" & i).Value <> "Started" Then Exit If
    '--------------------------------------
                Next
     End If