背景：使用VBA 6个月现在在64位机器上运行。 Excel 2010版本
两件事。一，这就是问题，只有一个用户为一行代码获得“脚本超出范围错误”。这对于具有相同硬件和操作系统规格的其他用户来说运行良好。其次，对代码优化的任何建议都很受欢迎。
发生错误的代码行：
Set apportion = Application.Workbooks("Apportionment " & year & " template for Granite Block Offshore extensions")
上面的工作簿是模块所在的位置并分配给一个按钮，因此在运行宏时不用说它是打开的和activeworkbook
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
答案 0 :(得分：0)
尝试添加扩展程序：
Set apportion = Application.Workbooks("Apportionment " & year & " template for Granite Block Offshore extensions.xls")
或.xlsm如果是宏观的话。用户可能隐藏了文件扩展名。
此外，您可能不想显示您的真实路径，而是使用\ mypath \而不是发布它