重新激活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