Циклическое подмножество листов Excel VBA

Я хочу перебрать подмножество листов в Excel с помощью VBA. Я хочу определить список листов на одном листе, а затем хочу прокрутить этот список. Ниже у меня есть код для перебора всей книги, но я хочу просто перебрать подмножество листов, которые я определяю. То, что я представляю, определяет диапазон листов, а затем перебирает этот диапазон. Любое понимание будет оценено.

Sub cyclethroughwbs()

Dim ws As Worksheet

For Each ws In ThisWorkbook.Sheets
ws.Select
ws.Calculate

Next ws

End Sub

loops excel vba worksheet-function
person Jeff Oland    schedule 10.03.2016    source источник

Ответы (2)


arrow_upward
2
arrow_downward

Скажем, 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
person Gary's Student    schedule 10.03.2016
comment
Почему вы выбрали лист перед его расчетом? - person N. Pavon; 10.03.2016
comment
Работает отлично! Спасибо - person West Ray; 24.04.2021

arrow_upward
0
arrow_downward

Я предлагаю два разных метода, оба из которых касаются возможных пустых ячеек и несуществующего рабочего листа.

первый саб "почти все-в-одном"

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

второе решение использует больше функций-оболочек, чтобы поддерживать чистоту и удобство кода. он также использует объект Collection, чтобы просто иметь дело с листами, которые вообще не найдены.

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
person user3598756    schedule 10.03.2016