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