此 Excel VBA 脚本中的下标超出范围错误
声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow
原文地址: http://stackoverflow.com/questions/19817399/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Subscript out of range error in this Excel VBA script
提问by user2883071
I would like to copy data from a CSV file into an Excel worksheet. There are 11 .csv files. So far I have this (it is a modified version from a previous post):
我想将数据从 CSV 文件复制到 Excel 工作表中。有 11 个 .csv 文件。到目前为止,我有这个(它是上一篇文章的修改版本):
Sub importData()
Dim filenum(0 To 10) As Long
filenum(0) = 052
filenum(1) = 060
filenum(2) = 064
filenum(3) = 068
filenum(4) = 070
filenum(5) = 072
filenum(6) = 074
filenum(7) = 076
filenum(8) = 178
filenum(9) = 180
filenum(10) = 182
Dim sh1 As Worksheet
On Error GoTo my_handler
For lngPosition = LBound(filenum) To UBound(filenum)
'Windows(filenum(lngPosition) & ".csv").Activate
Workbooks.Add(filenum(lngPosition) & ".csv").Activate
Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Windows("30_graphs_w_Macro.xlsm").Activate
Set sh1 = Worksheets(filenum(lngPosition)).Activate
Range("A69").Paste
Range("A69").Select
Next lngPositionlngPositionlngPosition
my_handler:
MsgBox "All done."
Exit Sub
End Sub
This code gives me a subscript out of range error on the line:
这段代码给了我一个下标超出范围的错误:
Set sh1 = Worksheets(filenum(lngPosition)).Activate
回答by Siddharth Rout
Set sh1 = Worksheets(filenum(lngPosition)).Activate
设置 sh1 = Worksheets(filenum(lngPosition)).Activate
You are getting Subscript out of range error
error becuase it cannot find that Worksheet.
您收到Subscript out of range error
错误,因为它找不到该工作表。
Also please... please... please do not use .Select/.Activate/Selection/ActiveCell
You might want to see How to Avoid using Select in Excel VBA Macros.
也请...请...请不要使用.Select/.Activate/Selection/ActiveCell
您可能想查看如何避免在 Excel VBA 宏中使用 Select。
回答by DanK
This looks a little better than your previous version but get rid of that .Activate on that line and see if you still get that error.
这看起来比你以前的版本好一点,但去掉那个。在那行激活,看看你是否仍然得到那个错误。
Dim sh1 As Worksheet
set sh1 = Workbooks.Add(filenum(lngPosition) & ".csv")
Creates a worksheet object. Not until you create that object do you want to start working with it. Once you have that object you can do the following:
创建工作表对象。在您创建该对象之前,您不想开始使用它。拥有该对象后,您可以执行以下操作:
sh1.Range("A69").Paste
sh1.Range("A69").Select
The sh1. explicitely tells Excel which object you are saying to work with... otherwise if you start selecting other worksheets while this code is running you could wind up pasting data to the wrong place.
sh1。明确地告诉 Excel 您要使用哪个对象...否则,如果您在此代码运行时开始选择其他工作表,您可能会将数据粘贴到错误的位置。
回答by Venkata Gowda
Private Sub CommandButton1_Click()
Dim Data As Object, Employee As Object
Application.ScreenUpdating = False
Set Data = ThisWorkbook.Sheets("Data")
Set Employee = ThisWorkbook.Sheets("Employee Names")
Data.Range("AK1").Value = "Lookup"
Data.Range("AK2:AK" & Data.Range("A1").End(xlDown).Row).Formula = "=VLOOKUP(E2,'Employee Names'!$A:$A,1,0)"
Data.Range("AK2:AK" & Data.Range("A1").End(xlDown).Row).Value = Data.Range("AK2:AK" & Data.Range("A1").End(xlDown).Row).Value
Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).AutoFilter Field:=5, Criteria1:="<>"
Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).AutoFilter Field:=37, Criteria1:="#N/A"
Application.DisplayAlerts = False
Data.AutoFilter.Range.Offset(1, 0).Rows.SpecialCells(xlCellTypeVisible).Delete (xlShiftUp)
Data.Range("AK:AK").Delete
Data.AutoFilterMode = False
'Selection.AutoFilter
Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).AutoFilter Field:=7, Criteria1:="="
Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).AutoFilter Field:=12, Criteria1:="<>"
Worksheets("Data").Range("A1:AK" & Data.Range("A1").End(xlDown).Row).Copy
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "DrfeeRequested"
Set Dr = ThisWorkbook.Worksheets("DrfeeRequested")
Dr.Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Data.AutoFilterMode = False
'DrfeeRequested.AutoFilterMode = False
Selection.AutoFilter
Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).AutoFilter Field:=13, Criteria1:="<>"
Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).Copy
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "RateLockfollowup"
Set Ratefolup = ThisWorkbook.Worksheets("RateLockfollowup")
Ratefolup.Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Data.AutoFilterMode = False
Selection.AutoFilter
Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).AutoFilter Field:=19, Criteria1:="="
Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).AutoFilter Field:=13, Criteria1:="<>"
Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).Copy
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Lockedlefollowup"
Set Lockfolup = ThisWorkbook.Worksheets("Lockedlefollowup")
Lockfolup.Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Data.AutoFilterMode = False
Selection.AutoFilter
Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).AutoFilter Field:=19, Criteria1:="="
Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).Copy
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Hoifollowup"
Set Hoifolup = ThisWorkbook.Worksheets("Hoifollowup")
Hoifolup.Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Data.AutoFilterMode = False
Selection.AutoFilter
TodayDT = Format(Now())
Weekdy = Weekday(Now())
If Weekdy = 2 Then
LastTwoDays = Now() - Weekday(Now(), 3)
ElseIf Weekdy = 3 Then
LastTwoDays = Now() - Weekday(Now(), 3)
ElseIf Weekdy = 4 Then
LastTwoDays = Now() - Weekday(Now(), 3)
ElseIf Weekdy = 5 Then
LastTwoDays = Now() - Weekday(Now(), 3)
ElseIf Weekdy = 6 Then
LastTwoDays = Now() - Weekday(Now(), 3)
Else
MsgBox "Today Satuarday OR Sunday Data is not Available"
End If
Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).AutoFilter Field:=12, Criteria1:="="
Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).AutoFilter Field:=11, Criteria1:="<>"
Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).AutoFilter Field:=11, Criteria1:=" TodayDT", Operator:=xlAnd, Criteria2:="LastTwoDays"
Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).Copy
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "DRfeefollowup"
Set Drfreefolup = ThisWorkbook.Worksheets("DRfeefollowup")
Drfreefolup.Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Data.AutoFilterMode = False
Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).AutoFilter Field:=15, Criteria1:="yes"
Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).AutoFilter Field:=19, Criteria1:="x"
Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).AutoFilter Field:=12, Criteria1:="<>"
Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).AutoFilter Field:=13, Criteria1:="<>"
'Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).AutoFilter Field:=14, criterial:="<>"
Data.Range("A1:AK" & Data.Range("A1").End(xlDown).Row).Copy
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Drworkblefiles"
Set Drworkblefiles = ThisWorkbook.Worksheets("Drworkblefiles")
Drworkblefiles.Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Data.Range("A1").AutoFilter
End Sub
Private Sub CommandButton2_Click()
Sheets("Data").Range("A1:AJ" & Sheets("Data").Range("A1").End(xlDown).Row).Clear
MsgBox "Please paste new data in data sheet"
End Sub