Excel VBA - перебрать конкретные листы в диапазоне

Question

Я хотел бы перебрать список листов, где список определяется диапазоном. Если я жестко закодирую список, все в порядке. я хотел бы сослаться на диапазон, который содержит имена листов (как переменные).

Set mySheets = Sheets(Array("sheetOne", "sheetTwo", "sheetThree"))

With ActiveWorkbook
    For Each ws In mySheets
    'do the stuff here
    Next ws
End With

, примерно так:

Set mySheets = Sheets(Range("A1:E1"))

Есть идеи?

Answer 1

Это будет работать:

Sub MySub()
    On Error Resume Next
    Set mySheets = Sheets(removeEmpty(rangeToArray(Range("A1:E1"))))
    If Err.Number = 9 Then
        MsgBox "An error has occurred. Check if all sheet names are correct and retry.", vbCritical
        Exit Sub
    End If
    On Error GoTo 0

    With ActiveWorkbook
        For Each ws In mySheets
        'do the stuff here
        Next ws
    End With
End Sub

'This will transpose a Range into an Array()
Function rangeToArray(rng As Range) As Variant
    rangeToArray = Application.Transpose(Application.Transpose(rng))
End Function

'This will remove empty values and duplicates
Function removeEmpty(arr As Variant) As Variant
    Dim result As New Scripting.Dictionary
    Dim element As Variant

    For Each element In arr
        If element <> "" And Not result.Exists(element) Then
            result.Add element, Nothing
        End If
    Next

    removeEmpty = result.Keys
End Function

Это будет загружаться динамически Sheets, содержащееся в вашем Range.

Редактировать

• Добавлено FunctionremoveEmpty(...) для удаления пустых значений и дубликатов.

Примечание : Function rangeToArray() необходим для возврата данных в формате Array().

Надеюсь, это поможет.

Answer 2

вы могли бы сделать так:

Sub DoThat()
    Dim cell As Range

    For Each cell In Range("A1:E1").SpecialCells(xlCellTypeConstants)
        If Worksheets(cell.Value2) Is Nothing Then
            MsgBox cell.Value2 & " is not a sheet name in " & ActiveWorkbook.Name & " workbook"
        Else
            With Worksheets(cell.Value2)
                'do the stuff here
                Debug.Print .Name
            End With
        End If
    Next
End Sub

или наоборот:

Sub DoThatTheOtherWayAround()
    Dim sht As Worksheet

    For Each sht In Worksheets
        If Not IsError(Application.Match(sht.Name, Range("A1:E1"), 0)) Then
            'do the stuff here
            Debug.Print sht.Name
        End If
    Next
End Sub

, но в этом последнем случае вам не советуют в случае какого-либо А1: Значение E1 не соответствует фактическому имени листа

Answer 3

Я демонстрирую код ниже, который делает то, что вы хотите, используя анимированный GIF (нажмите для более подробной информации)

Option Explicit
Sub iterateSheets()
Dim sh As Worksheet, shName As String, i As Integer
i = 0
For Each sh In ThisWorkbook.Worksheets
    shName = sh.Range("A1").Offset(i, 0)
    Worksheets(shName).Range("A1").Offset(i, 0).Font.Color = vbRed
    i = i + 1
Next
End Sub

Answer 4

Я бы предоставил это решение, которое загружает имена листов в массив: обратите внимание, что вам нужно транспонировать данные, если значения упорядочены по горизонтали.

Public Sub test()
Dim mySheet As Variant
Dim sheet As Variant

mySheet = Application.Transpose(Tabelle1.Range("A1:E1").Value) 'load your Values into an Array, of course the range can also be dynamic

For Each sheet In mySheet
    Debug.Print sheet 'print the sheet names, just for explaining purposes
    'it may be necessary to use CStr(sheet) if you want to refer to a sheet like Thisworkbook.Worksheets(CStr(sheet))
    'Do something
Next sheet

Erase mySheet 'delete the Array out of memory
End Sub