表格Excel VBA的循环子集

我想使用VBA在Excel中循环显示一个表单子集。 我想在一张纸上定义纸张的列表,然后我想通过该列表循环。 下面我有代码来循环通过整本书,但我想要的只是循环通过我定义的工作表的子集。 我设想的是定义一系列的表单,然后循环遍历该范围。 任何有识之士将不胜感激。

Sub cyclethroughwbs() Dim ws As Worksheet For Each ws In ThisWorkbook.Sheets ws.Select ws.Calculate Next ws End Sub 

Sheet1有在A列中处理的工作表列表:

在这里输入图像说明

这段代码将遍历它们:

 Sub LoopOverListOfSheets() Dim N As Long, i As Long With Sheets("Sheet1") N = .Cells(Rows.Count, "A").End(xlUp).Row For i = 1 To N Sheets(.Cells(i, "A").Value).Select Sheets(.Cells(i, "A").Value).Calculate Next i End With End Sub 

我提出了两种不同的技术,都处理可能的空白单元格和不存在的工作表

第一个是“几乎全在一起”的子

 Option Explicit Sub LoopOverListOfSheets() Dim shtNamesRng As Range, cell As Range Dim sht As Worksheet With ThisWorkbook.Worksheets("SheetWithNames") Set shtNamesRng = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeConstants, xlTextValues) End With For Each cell In shtNamesRng Set sht = SetSheet(ThisWorkbook, cell.Value) If Not sht Is Nothing Then With sht .Calculate '... other code on "sht" End With End If Next cell End Sub Function SetSheet(wb As Workbook, shtName As String) As Worksheet On Error Resume Next Set SetSheet = wb.Worksheets(shtName) On Error GoTo 0 End Function 

第二个解决scheme使用更多的“包装”function来保持代码清洁和可维护性。 它也使用Collection对象来处理根本没有find的表单

 Option Explicit Sub LoopOverListOfSheets2() Dim shtsColl As Collection Dim sht As Worksheet Set shtsColl = GetSheets(ThisWorkbook.Worksheets("SheetWithNames")) For Each sht In shtsColl ' sht.Calculate '... Next sht End Sub Function GetSheets(namesSht As Worksheet) As Collection Dim myColl As New Collection Dim shtNamesRng As Range, cell As Range Dim sht As Worksheet With namesSht Set shtNamesRng = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeConstants, xlTextValues) For Each cell In shtNamesRng Set sht = SetSheet(namesSht.Parent, cell.Value) If Not sht Is Nothing Then myColl.Add sht Next cell End With Set GetSheets = myColl End Function Function SetSheet(wb As Workbook, shtName As String) As Worksheet On Error Resume Next Set SetSheet = wb.Worksheets(shtName) On Error GoTo 0 End Function