使用 VBA 在 Excel 中进行时间序列分析

Question

我有一个最多包含 103 张工作表的工作簿。

• 101 张工作表将有不同的产品体积用于时间序列分析。
• 有一个 RAW 数据选项卡，每张纸都会从中提取初始体积数据。
• 有一个汇总表，用于对所有 101 项进行 12 个月的预测。

我想从表 3 循环到 103 并自动化数据分析，时间序列分析的回归部分，以将时间序列数据刷新到摘要表上。

我在下面创建了一个代码来展示我的尝试。我遇到的问题是：

• 我必须单击“是”来覆盖以前的回归数据，该数据在每张表中的 $S$33 范围内。我认为 Application.DisplayAlerts = False 可以解决这个问题。
• 每个月范围都会改变。它总是从 $L$2 和 $C$2 开始，但是需要运行到上个月。 （请参见下面突出显示的内容）我们现在是 19 年 6 月，因此它需要介于 2 美元到 43 美元和 2 美元到 43 美元之间，因为 43 号线是 5 月 19 日的线。

 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

Answer 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

Answer 2

还没来得及早点回答……这是另一种方法：

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 文件中），您将无法做很多事情。