[英]Subscript out of range error in this Excel VBA script
我想将数据从 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
这段代码给了我一个下标超出范围的错误:
Set sh1 = Worksheets(filenum(lngPosition)).Activate
设置 sh1 = Worksheets(filenum(lngPosition)).Activate
您收到下Subscript out of range error
错误,因为它找不到该工作表。
也请...请...请不要使用.Select/.Activate/Selection/ActiveCell
您可能想查看如何避免在 Excel VBA 宏中使用 Select 。
这看起来比你以前的版本好一点,但去掉那个。在那行激活,看看你是否仍然得到那个错误。
Dim sh1 As Worksheet
set sh1 = Workbooks.Add(filenum(lngPosition) & ".csv")
创建工作表对象。 在您创建该对象之前,您不想开始使用它。 拥有该对象后,您可以执行以下操作:
sh1.Range("A69").Paste
sh1.Range("A69").Select
sh1。 明确地告诉 Excel 您要使用哪个对象...否则,如果您在此代码运行时开始选择其他工作表,您可能会将数据粘贴到错误的位置。
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.