Vba excel массив книг

ThisWorkbook.Sheets(Array("Sheet1", "Sheet3"))
ThisWorkbook.Sheets(Array("Sheet2", "Sheet5"))

Dim ArrayOne As String
Dim ArrayTwo As String

ArrayOne = ThisWorkbook.Sheets(Array("Sheet1", "Sheet3"))
ArrayTwo = ThisWorkbook.Sheets(Array("Sheet2", "Sheet5"))

ArrayOne 'Call this Array then save

Filename:="C:Datatestfile.xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _,
CreateBackup:=False 

ArrayTwo 'Call this array then save

Filename:="C:Datatestfile.xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _,
CreateBackup:=False 

2

Я пытаюсь создать массив, содержащий все имена рабочих листов, начиная с 4-го рабочего листа в активной рабочей книге. Я получаю сообщение об ошибке в 4-й строке, когда я пытаюсь изменить размер массива. Чего мне не хватает? В настоящее время существует 6 рабочих листов, третья скрыта (на случай, если что-то изменится).

Dim i As Integer
Dim sheetsToSkip() As Variant
For i = 4 To Sheets.Count
    ReDim Preserve sheetsToSkip(UBound(sheetsToSkip) + 1)
    sheetsToSkip(UBound(sheetsToSkip)) = Sheets(i).Name
Next i

@BigBen на правильном пути. Вы должны ReDim только один раз:

Public Function ListWorkssheets()

    Dim SheetsToSkip()  As String
    Dim Count           As Integer
    Dim Index           As Integer
    
    Count = ThisWorkbook.Worksheets.Count
    ReDim SheetsToSkip(1 To Count)
    
    For Index = 1 To Count
        SheetsToSkip(Index) = ThisWorkbook.Worksheets((Index + 3 - 1) Mod Count + 1).Name
    Next
    
    ' Verify.
    For Index = LBound(SheetsToSkip) To UBound(SheetsToSkip)
        Debug.Print Index, SheetsToSkip(Index)
    Next

End Function

Вот несколько примеров, если сначала вы подсчитаете «действительные» листы (если вы избегаете включать листы по имени) — это поможет.

— Версия 1 — не надо проверять (просто получить все имена листов в массиве)

Sub SheetNamesToArray()

Dim MyWb As Workbook
Dim MySheet As Worksheet
Dim SheetNameArray() As String  ' Array of Sheet Names
Dim LP As Integer ' ( Generic Loop Variable )

Set MyWb = ActiveWorkbook

    ':: Redim to workbook count
    ReDim SheetNameArray(MyWb.Sheets.Count)
    
    ':: Check Array Size
    Debug.Print UBound(SheetNameArray) & " = " & MyWb.Sheets.Count

    ':: Set Array from Sheet Names
    For LP = 1 To MyWb.Sheets.Count
        SheetNameArray(LP) = Sheets(LP).Name
        Debug.Print SheetNameArray(LP) & " :" & Sheets(LP).Name
    Next LP


End Sub

— Версия 2 — проверять имена, сохранять только действительные (используя Inst для проверки, есть ли у нескольких листов определенная строка в имени)

Sub SheetNamesToArray_And_Ignore_Names()

Dim MyWb As Workbook
Dim MySheet As Worksheet
Dim SheetNameArray() As String  ' Array of Sheet Names
Dim LP, LPx As Integer ' ( Generic Loop Variable(s) )
Dim MyValidSheetsCount As Integer  ' Array Size for only 'valid' sheets


    ':: Apply to active workbook
    Set MyWb = ActiveWorkbook

    For LP = 1 To MyWb.Sheets.Count
        ':: Skip over names to ignore..
        If InStr(1, Sheets(LP).Name, "Four", vbTextCompare) = 0 Then
            '::Iterate count of 'valid' sheets ::
            MyValidSheetsCount = MyValidSheetsCount + 1
        End If
    
    Next LP

    ':: Redim to workbook count
    ReDim SheetNameArray(MyValidSheetsCount)
    
    LPx = 0
    
    ':: Set Array from Sheet Names
    For LP = 1 To MyWb.Sheets.Count

        ':: Same test again, this time add to array, and iterate index variable ( LPX )
        If InStr(1, Sheets(LP).Name, "Four", vbTextCompare) = 0 Then
            SheetNameArray(LPx) = Sheets(LP).Name
            '::Iterate array index ::
            LPx = LPx + 1
        End If

    Next LP

    Debug.Print "Found " & LPx & " valid sheets" & vbNewLine
    
    ':: Check only the 'valid' sheets are recorded
    For LP = 0 To LPx - 1
      Debug.Print "(" & Format(LP, "000#") & ")  : " & SheetNameArray(LP)
    Next LP

End Sub

С VBA, вероятно, есть несколько способов получить тот же результат.

Для первоначального вопроса, если вы просто пытаетесь пропустить последние 4 и не обеспокоены тем, что они могут быть не в порядке, выполните:

Sub ReallySimpleJustUseNumbers()

':: N.B.  Sheets are indexed starting at 1, arrays begin at 0 ..

Dim MyWb As Workbook
Dim MySheet As Worksheet
Dim SheetNameArray() As String  ' Array of Sheet Names
Dim LP As Integer ' ( Generic Loop Variable )

Set MyWb = ActiveWorkbook

    ':: Are there greater than four sheets in this workbook ?
    If MyWb.Sheets.Count > 4 Then
        ':: Redim to workbook count
        ReDim SheetNameArray(MyWb.Sheets.Count - 4)
    Else
        ':: Polite Exit
        MsgBox "Too Few Sheets buddy"
        Exit Sub
    End If
    
    For LP = 4 To MyWb.Sheets.Count
        SheetNameArray(LP - 4) = MyWb.Sheets(LP).Name
    Next LP
    
    ':: Output array
    For LP = 0 To UBound(SheetNameArray)
        Debug.Print LP & " --- " & SheetNameArray(LP)
    Next LP

End Sub

Это просто начнет заполнять массив, как определено как Количество листов — Четыре начальных листа, индекс начинается с 0

Проблема в том, что ваш массив sheetsToSkip еще не имеет верхней границы в первом цикле цикла. Вы можете проверить, является ли sheetsToSkip массивом в первом цикле, а затем либо измерить его в первый раз, либо изменить его размер.

Предложение по коду:

Sub CreateSheetNameArray()
    Dim i As Integer
    'Brakets are removed
    Dim sheetsToSkip As Variant

    For i = 4 To Sheets.Count
        If IsEmpty(sheetsToSkip) Then
            ReDim sheetsToSkip(0 To 0)
        Else
            ReDim Preserve sheetsToSkip(UBound(sheetsToSkip) + 1)
        End If
        sheetsToSkip(UBound(sheetsToSkip)) = Sheets(i).Name
    Next i
End Sub

Помните, что ReDim Preserve медленный. Если у вас есть много циклов цикла, вы можете просто измерять массив перед циклом.