VBA Excel查找工作表名称，IF标签已经“启动”，然后通过这些工作表循环

我有一个函数在我的VBA脚本，目前循环通过所有的数字表名称，并执行一个函数。 001，002，003等

我希望能够对此进行优化，以便仅查看标记为“开始”的表单名称。 我在同一个工作簿中有一张名为“主动索引”的表，它列出了第一列（A）中的表格编号（带有超链接，希望这不会引起问题），同一表中有一个“状态”列5 （E）每个表格包含“开始”，“主意”，“持有”。

然后，VBA脚本将相关选项卡上的某些信息复制并粘贴到名为actions summary的新表中。

我希望简单地replace下面的代码段来做到这一点。 有任何想法吗？

'Loop through all sheets in the workbook For Each ws In wb.Sheets 'Only look for worksheets whose names are numbers (eg "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 (eg "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：你也可以尝试类似下面的代码，这样你必须replace你所build议的代码-----之间的所有东西， 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