我有一本多达103张的工作簿。
我想从工作表3循环到103,并自动进行数据分析和时间序列分析的回归部分,以将时间序列数据刷新到摘要表上。
我在下面创建了代码以显示我尝试过的内容。我遇到的问题是:
Sub TSA ()
'
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'
Sheets("SPCS000052").Activate
Application.Run "ATPVBAEN.XLAM!Regress", ActiveSheet.Range("$L$2:$L$42"), _
ActiveSheet.Range("$C$2:$C$42"), False, True, , ActiveSheet.Range("$S$33") _
, False, False, False, False, , False
Sheets("SPCS000053").Activate
Application.Run "ATPVBAEN.XLAM!Regress", ActiveSheet.Range("$L$2:$L$42"), _
ActiveSheet.Range("$C$2:$C$42"), False, True, , ActiveSheet.Range("$S$33") _
, False, False, False, False, , False
Sheets("SPCS000130").Activate
Application.Run "ATPVBAEN.XLAM!Regress", ActiveSheet.Range("$L$2:$L$42"), _
ActiveSheet.Range("$C$2:$C$42"), False, True, , ActiveSheet.Range("$S$33") _
, False, False, False, False, , False
Sheets("SPCS000078").Activate
Application.Run "ATPVBAEN.XLAM!Regress", ActiveSheet.Range("$L$2:$L$42"), _
ActiveSheet.Range("$C$2:$C$42"), False, True, , ActiveSheet.Range("$S$33") _
, False, False, False, False, , False
Sheets("SPCS000063").Activate
Application.Run "ATPVBAEN.XLAM!Regress", ActiveSheet.Range("$L$2:$L$42"), _
ActiveSheet.Range("$C$2:$C$42"), False, True, , ActiveSheet.Range("$S$33") _
, False, False, False, False, , False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
答案 0 :(得分:1)
可以通过编程设置范围,您可以使用变量而不是Activesheet来引用它们。您可以使用一个循环,在其中可以组合工作表的名称。所以我会做这样的事情:
Dim iLastRow as Long, i As Long
Dim rC as Range, rL as Range, rS as Range
Dim sh As Worksheet
For i = 3 to 101
sSheetName = "SPCS" & Format(i, "000000")
Set sh = Sheets(sSheetName)
If Err.Number <> 0 Then ' check success
Debug.Print "Error with sheet " & sSheetName
Else
iLastRow = sh.Cells(sh.Rows.Count, 1).End(xlUp).Row
Set rL = Range(sh.Cells(2, 12), sh.Cells(iLastRow, 12) ' L column
Set rC = Range(sh.Cells(2, 3), sh.Cells(iLastRow, 3) ' C column
Set rS = Range(sh.Cells(2, 19), sh.Cells(iLastRow, 19) ' S column
Application.Run "ATPVBAEN.XLAM!Regress", rL, rC, False, True, , _
rS, _False, False, False, False, , False
End If
Next
这只是一个简单提示。您需要添加更多行以使其健壮,例如检查iLastRow是否为0或Set rX
是否成功,但是第一次尝试会成功。对于我认为其他人已经遇到此问题的警报,请参阅以下内容:suppress-overwrite-existing-data-alert-in-vba-macro ATPVBAEM似乎忽略/覆盖了DisplayAlert
设置。
编辑:查找最后一行已得到纠正,thanx @ ja72
答案 1 :(得分:1)
还没来得及早回答...这是另一种解决方法:
Sub TSA()
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
Dim wb As Workbook: Set wb = ActiveWorkbook 'or ThisWorkbook, or Workbooks("book name")
Dim ws As Worksheet, rng As Range
For Each ws In wb.Worksheets
'Alternatively: If ws.Name <> "Data" And ws.Name <> "Summary" Then
Set rng = ws.Range("C2:C" & ws.Cells(Rows.Count, "C").End(xlUp).Row)
If Left(ws.Name, 4) = "SPCS" Then
With ws
Application.Run "ATPVBAEN.XLAM!Regress", _
.Range(rng.Offset(0, 9)), _
.Range(rng), _
False, _
True, _
, _
.Range("$S$33") '_
', False, False, False, False, , False
'Since most of the parameters are optional, and last ones you are only passing false values, you can ditch them.
'uncomment them above if you get any weird results because a false value was actually required
End With
End If
Next ws
With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub
不幸的是,该消息框是内置在AddIn本身中的,并且即使您具有AddIn的密码(Wildebeest!!
)(鉴于实际功能存储在ANALYS32.XLL
文件中),您也不会对此无能为力。