在for循环VBA中重新激活以前的工作簿

Question

我有一个宏可以打开一个工作簿，使用 VLOOKUP 将 24 小时的数据复制到一个数组中，然后将该数组粘贴到主工作簿中，然后它应该返回到打开的工作簿并将另一组数据复制到数组中。不幸的是，在复制第一组数据后，我得到“下标超出范围”。我知道原因是宏试图激活一个即使它已经打开也找不到的工作簿

Sub main()

Dim fname As String, pathfile As String, year As Long, month As Long, day As Long
Dim version As Long, nazwa_raportu As String, miesiac As String, dzien As String
Dim hour As Long, godzina As Long
Dim Arr(1 To 10) As String, Data(0 To 23) As Long
Dim i As Long, fullname As String

Arr(1) = "somename1"
Arr(2) = "somename2"
Arr(3) = "somename3"
Arr(4) = "somename4"
Arr(5) = "somename5"
Arr(6) = "somename6"
Arr(7) = "somename7"
Arr(8) = "somename8"
Arr(9) = "somename9"
Arr(10) = "somename10"

For month = 1 To 12
    If month < 10 Then
        miesiac = "0" & month
    Else
        miesiac = month
    End If

    For day = 1 To 31
        If day < 10 Then
            dzien = "0" & day
        Else
            dzien = day
        End If

        Do
            pathfile = "C:\Users\M\Documents\Reports\XXXX\ARDR\"
            fname = pathfile & miesiac & "_" & dzien & "_" & ".xls"
            ' if file not present skip
            If Len(Dir(fname)) = 0 Then
                Exit Do
            End If
            Workbooks.Open (fname)
            fullname = Application.ActiveWorkbook.fullname

            For i = 1 To 10
                For hour = 0 To 23
                    Data(hour) = Application.WorksheetFunction.VLookup(Arr(i), Range(Cells(1, 1), Cells(100, 80)), 4 + 3 * hour, False)
                Next hour
                For godzina = 0 To 23
                    Workbooks("main.xlsm").Activate
                    Cells(3 + godzina * day, 1 + i * 2) = Dane(godzina)
                Next godzina
                Workbooks(fullname).Activate
            Next i

        Loop While False
    Next day
Next month

如何重新激活循环之前打开的工作簿

 For i = 1 To 10

当我还在那个循环中的时候？

Answer 1

试试下面的代码（我已经注释了我添加的新行）：

Dim NewWB As Workbook ' <-- New Workbook Object declaration

For month = 1 To 12
    If month < 10 Then
        miesiac = "0" & month
    Else
        miesiac = month
    End If

    For day = 1 To 31
        If day < 10 Then
            dzien = "0" & day
        Else
            dzien = day
        End If

        Do
            pathfile = "C:\Users\M\Documents\Reports\XXXX\ARDR\"
            fname = pathfile & miesiac & "_" & dzien & "_" & ".xls"
            ' if file not present skip
            If Len(Dir(fname)) = 0 Then
                Exit Do
            End If
            Set NewWB = Workbooks.Open(fname) '<-- Set the Opened workbook to a Workbook Object

            For i = 1 To 10
                For hour = 0 To 23
                    Data(hour) = Application.WorksheetFunction.VLookup(Arr(i), Range(Cells(1, 1), Cells(100, 80)), 4 + 3 * hour, False)
                Next hour
                For godzina = 0 To 23
                    Workbooks("main.xlsm").Activate
                    Cells(3 + godzina * day, 1 + i * 2) = Dane(godzina)
                Next godzina
                NewWB.Activate ' <-- activate again (inside the loop)
            Next i

        Loop While False

        Set NewWB = Nothing '<-- Clear Object
    Next day
Next month