重新激活for循环VBA中的以前的工作簿
问题描述:
我有一个宏可以打开一个工作簿,使用VLOOKUP将数据复制到数组中24小时,然后将数组粘贴到主工作簿中,然后应该返回到打开的工作簿并复制另一个工作簿数据集到数组中。不幸的是,在复制第一组数据后,我得到“下标超出范围”。我知道,原因是宏试图激活一个工作簿,即使它已经打开重新激活for循环VBA中的以前的工作簿
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
虽然之前打开的工作簿无法找到我仍然在这个循环?
答
试试下面的代码(我曾经评论的新生产线,我加的):
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
你可以做'设置srcWB =工作簿(源工作簿的名称)'和'设置trgWB =工作簿(目标工作簿名称)'这样你可以来回切换。 – ian0411