0
배경 : 64 비트 시스템에서 실행되는 6 개월 동안 VBA 사용. Excel 2010 버전한 사용자에 대해서만 스크립트가 범위를 벗어 났습니까?
두 가지. 하나, 그리고 이것은 문제이며, 한 줄의 코드에 대해 '범위를 벗어난 스크립트 오류'를받는 사용자 한 명과 관련이 있습니다. 이것은 동일한 하드웨어 및 OS 사양을 가진 다른 사용자에게 잘 돌아갔다. 둘째, 코드 최적화에 대한 조언이 잘 전달됩니다.
오류가 발생 코드의라인 :
Set apportion = Application.Workbooks("Apportionment " & year & " template for Granite Block Offshore extensions")
매크로
Option Explicit
Sub getEst()
'Used for inserting values from quarterly estimates paid to shareholders
Dim xCell As Range, findCell As Range, carryFWDrng1 As Range, carryFWDrng2 As Range
Dim Q1_est_paid As Range, Q2_est_paid As Range, Q3_est_paid As Range, Q4_est_paid As Range
Dim tempST$, tempState$, qtr$, year$, pYear$, STest$
Dim apportion As Workbook, STabbr As Workbook, carryFWD As Workbook
Dim qrtEst1 As Workbook, qrtEst2 As Workbook, qrtEst3 As Workbook, qrtEst4 As Workbook
Dim q1Federal&, q2Federal&, q3Federal&, q4Federal&
Dim t As Date
Dim STabbrPath$, STabbrFname$, carryFWDpath$, carryFWDfName$
Dim qrtEst1Path$, qrtEst1Fname$, qrtEst2Path$, qrtEst2Fname$, qrtEst3Path$, qrtEst3Fname$, qrtEst4Path$, qrtEst4Fname$
'input box to get year for future use
year = InputBox("Please type in the tax return year", "Tax Return Year", Format(Date - 365, "YYYY"))
pYear = year - 1
' t = Now() 'timer to measure sub length
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.AskToUpdateLinks = False
'list file pathways and file names
STabbrPath = "\\TXLEWFPS02\Departments-ndc\Tax\TAX_DEPT\INCOME TAX\"
STabbrFname = "States w Abbr.xlsx"
qrtEst1Path = "\\TXLEWFPS02\Departments-ndc\Tax\TAX_DEPT\INCOME TAX\" & year & " Income Tax\Q1 " & year & "\Blocker & LP Check Requests\"
qrtEst1Fname = "GBO Q1 " & year & " Estimates Funds Request.xlsx"
qrtEst2Path = "\\TXLEWFPS02\Departments-ndc\Tax\TAX_DEPT\INCOME TAX\" & year & " Income Tax\Q2 " & year & "\Blocker & LP Check Requests\"
qrtEst2Fname = "GBO Q2 " & year & " Estimates Funds Request.xlsx"
qrtEst3Path = "\\TXLEWFPS02\Departments-ndc\Tax\TAX_DEPT\INCOME TAX\" & year & " Income Tax\Q3 " & year & "\Blocker & LP Check Requests\"
qrtEst3Fname = "GBO Q3 " & year & " Estimates Funds Request.xlsx"
qrtEst4Path = "\\TXLEWFPS02\Departments-ndc\Tax\TAX_DEPT\INCOME TAX\" & year & " Income Tax\Q4 " & year & "\Blocker & LP Check Requests\"
qrtEst4Fname = "GBO Q4 " & year & " Estimates Funds Request.xlsx"
carryFWDpath = "\\TXLEWFPS02\Departments-ndc\Tax\TAX_DEPT\INCOME TAX\Blocker Returns\" & pYear & "\Granite Block Offshore\"
carryFWDfName = "Granite Block Offshore income tax recap " & pYear & ".xlsx"
'open files
Application.Workbooks.Open Filename:=STabbrPath & STabbrFname
Application.Workbooks.Open Filename:=qrtEst1Path & qrtEst1Fname
Application.Workbooks.Open Filename:=qrtEst2Path & qrtEst2Fname
Application.Workbooks.Open Filename:=qrtEst3Path & qrtEst3Fname
Application.Workbooks.Open Filename:=qrtEst4Path & qrtEst4Fname
Application.Workbooks.Open Filename:=carryFWDpath & carryFWDfName
Set apportion = Application.Workbooks("Apportionment " & year & " template for Granite Block Offshore extensions")
Set STabbr = Application.Workbooks("States w Abbr")
Set carryFWD = Application.Workbooks("Granite Block Offshore income tax recap " & pYear)
Set qrtEst1 = Application.Workbooks("GBO Q1 " & year & " Estimates Funds Request")
Set qrtEst2 = Application.Workbooks("GBO Q2 " & year & " Estimates Funds Request")
Set qrtEst3 = Application.Workbooks("GBO Q3 " & year & " Estimates Funds Request")
Set qrtEst4 = Application.Workbooks("GBO Q4 " & year & " Estimates Funds Request")
Set Q1_est_paid = Application.Workbooks("Apportionment " & year & " template for Granite Block Offshore extensions") _
.Worksheets("Granite Block Offshore").Range("F58:DB58")
Set Q2_est_paid = Application.Workbooks("Apportionment " & year & " template for Granite Block Offshore extensions") _
.Worksheets("Granite Block Offshore").Range("F60:DB60")
Set Q3_est_paid = Application.Workbooks("Apportionment " & year & " template for Granite Block Offshore extensions") _
.Worksheets("Granite Block Offshore").Range("F62:DB62")
Set Q4_est_paid = Application.Workbooks("Apportionment " & year & " template for Granite Block Offshore extensions") _
.Worksheets("Granite Block Offshore").Range("F64:DB64")
Set carryFWDrng1 = Application.Workbooks("Apportionment " & year & " template for Granite Block Offshore extensions") _
.Worksheets("Granite Block Offshore").Range("F57:DB57")
Set carryFWDrng2 = Application.Workbooks("Granite Block Offshore income tax recap " & pYear) _
.Worksheets("Granite Block Offshore").Range("K9:K59")
apportion.Activate
'For loop to move through each cell in carryFWD range
For Each xCell In carryFWDrng1
If xCell.Offset(-56, 0).Value = "" Then
'do nothing
Else: tempST = xCell.Offset(-56, 0).Value
STabbr.Activate 'activate States w Abbr file to find full state name
Set findCell = Range("B1:B51").Find(what:=tempST, lookat:=xlWhole, After:=Range("B1")) 'search ST range and find tempST var
If findCell Is Nothing Then
'do nothing
Else: tempState = findCell.Offset(0, -1).Value 'populate tempState var
End If
Set findCell = Nothing 'clear findcell in memory
carryFWD.Activate 'activate GBO tax recap file
Set findCell = Range("A9:A59").Find(what:=tempState, lookat:=xlWhole, After:=Range("A9")) 'search State range and find tempState var
If findCell Is Nothing Then
STest = "0"
Else: STest = findCell.Offset(0, 10).Value
End If
Set findCell = Nothing 'clear findcell in memory
apportion.Activate 'activate apportion file
xCell.Value = STest
End If
Next xCell
apportion.Activate
'For loop to move through each cell in Q1 range
For Each xCell In Q1_est_paid
If xCell.Offset(-57, 0).Value = "" Then
'do nothing
Else: tempST = xCell.Offset(-57, 0).Value
STabbr.Activate 'activate States w Abbr file to find full state name
Set findCell = Range("B1:B51").Find(what:=tempST, lookat:=xlWhole, After:=Range("B1")) 'search ST range and find tempST var
If findCell Is Nothing Then
'do nothing
Else: tempState = findCell.Offset(0, -1).Value 'populate tempState var
End If
Set findCell = Nothing 'clear findcell in memory
qrtEst1.Activate 'activate Q1 payment file
Set findCell = Range("A7:A60").Find(what:=tempState, lookat:=xlWhole, After:=Range("A7")) 'search State range and find tempState var
If findCell Is Nothing Then
STest = "0"
Else: STest = findCell.Offset(0, 1).Value
End If
Set findCell = Nothing 'clear findcell in memory
apportion.Activate 'activate apportion file
xCell.Value = STest
End If
Next xCell
qrtEst1.Activate 'get Federal est in Q1
q1Federal = qrtEst1.Worksheets("GBO").Range("B5")
apportion.Activate
apportion.Worksheets("Granite Block Offshore").Range("D58").Value = q1Federal
'For loop to move through each cell in Q2 range
For Each xCell In Q2_est_paid
If xCell.Offset(-59, 0).Value = "" Then
'do nothing
Else: tempST = xCell.Offset(-59, 0).Value
STabbr.Activate 'activate States w Abbr file to find full state name
Set findCell = Range("B1:B51").Find(what:=tempST, lookat:=xlWhole, After:=Range("B1")) 'search ST range and find tempST var
If findCell Is Nothing Then
'do nothing
Else: tempState = findCell.Offset(0, -1).Value 'populate tempState var
End If
Set findCell = Nothing 'clear findcell in memory
qrtEst2.Activate 'activate Q2 payment file
Set findCell = Range("A7:A60").Find(what:=tempState, lookat:=xlWhole, After:=Range("A7")) 'search State range and find tempState var
If findCell Is Nothing Then
STest = "0"
Else: STest = findCell.Offset(0, 1).Value
End If
Set findCell = Nothing 'clear findcell in memory
apportion.Activate 'active apportion file
xCell.Value = STest
End If
Next xCell
qrtEst2.Activate 'get Federal est in Q2
q2Federal = qrtEst2.Worksheets("GBO").Range("B5")
apportion.Activate
apportion.Worksheets("Granite Block Offshore").Range("D60").Value = q2Federal
'For loop to move through each cell in Q3 range
For Each xCell In Q3_est_paid
If xCell.Offset(-61, 0).Value = "" Then
'do nothing
Else: tempST = xCell.Offset(-61, 0).Value
STabbr.Activate 'activate States w Abbr file to find full state name
Set findCell = Range("B1:B51").Find(what:=tempST, lookat:=xlWhole, After:=Range("B1")) 'search ST range and find tempST var
If findCell Is Nothing Then
'do nothing
Else: tempState = findCell.Offset(0, -1).Value 'populate tempState var
End If
Set findCell = Nothing 'clear findcell in memory
qrtEst3.Activate 'activate Q3 payment file
Set findCell = Range("A7:A60").Find(what:=tempState, lookat:=xlWhole, After:=Range("A7")) 'search State range and find tempState var
If findCell Is Nothing Then
STest = "0"
Else: STest = findCell.Offset(0, 1).Value
End If
Set findCell = Nothing 'clear findcell in memory
apportion.Activate 'active apportion file
xCell.Value = STest
End If
Next xCell
qrtEst3.Activate 'get Federal est in Q3
q3Federal = qrtEst3.Worksheets("GBO").Range("B5")
apportion.Activate
apportion.Worksheets("Granite Block Offshore").Range("D62").Value = q3Federal
'For loop to move through each cell in Q4 range
For Each xCell In Q4_est_paid
If xCell.Offset(-63, 0).Value = "" Then
'do nothing
Else: tempST = xCell.Offset(-63, 0).Value
STabbr.Activate 'activate States w Abbr file to find full state name
Set findCell = Range("B1:B51").Find(what:=tempST, lookat:=xlWhole, After:=Range("B1")) 'search ST range and find tempST var
If findCell Is Nothing Then
'do nothing
Else: tempState = findCell.Offset(0, -1).Value 'populate tempState var
End If
Set findCell = Nothing 'clear findcell in memory
qrtEst4.Activate 'activate Q3 payment file
Set findCell = Range("A7:A60").Find(what:=tempState, lookat:=xlWhole, After:=Range("A7")) 'search State range and find tempState var
If findCell Is Nothing Then
STest = "0"
Else: STest = findCell.Offset(0, 1).Value
End If
Set findCell = Nothing 'clear findcell in memory
apportion.Activate 'active apportion file
xCell.Value = STest
End If
Next xCell
qrtEst4.Activate 'get Federal est in Q4
q4Federal = qrtEst4.Worksheets("GBO").Range("B5")
apportion.Activate
apportion.Worksheets("Granite Block Offshore").Range("D64").Value = q4Federal
Range("DK57").Value = "Carry FWD source file pathway"
Range("DK58").Value = "Q1 source file pathway"
Range("DK60").Value = "Q2 source file pathway"
Range("DK62").Value = "Q3 source file pathway"
Range("DK64").Value = "Q4 source file pathway"
Range("DL57").Value = carryFWDpath & carryFWDfName
Range("DL58").Value = qrtEst1Path & qrtEst1Fname
Range("DL60").Value = qrtEst2Path & qrtEst2Fname
Range("DL62").Value = qrtEst3Path & qrtEst3Fname
Range("DL64").Value = qrtEst4Path & qrtEst4Fname
STabbr.Close savechanges:=False
carryFWD.Close savechanges:=False
qrtEst1.Close savechanges:=False
qrtEst2.Close savechanges:=False
qrtEst3.Close savechanges:=False
qrtEst4.Close savechanges:=False
Set Q1_est_paid = Nothing
Set Q2_est_paid = Nothing
Set Q3_est_paid = Nothing
Set Q4_est_paid = Nothing
Set qrtEst1 = Nothing
Set qrtEst2 = Nothing
Set qrtEst3 = Nothing
Set qrtEst4 = Nothing
Set STabbr = Nothing
Set apportion = Nothing
Set carryFWD = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.AskToUpdateLinks = True
'MsgBox ("Macro duration : " & Format(Now() - t, "hh:mm:ss")) 'timer results
End Sub
를 실행할 때 모듈이 위치하며, 오픈을 말할 때문에 불필요한 버튼과 activeworkbook에 할당되는 경우 위의 통합 문서입니다
Set apportion = Application.Workbooks("Apportionment " & year & " template for Granite Block Offshore extensions.xls")
또는 .xlsm
macr 경우 :