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

时间:2019-06-05 12:53:26

标签: excel vba excel-formula analytics

我有一本多达103张的工作簿。

  • 101张纸将具有不同的产品量用于时间序列分析。
  • 有一个RAW数据选项卡,每张纸都将从中读取初始体积数据。
  • 有一个摘要表,用于汇总所有101个项目的12个月预测。

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

我在下面创建了代码以显示我尝试过的内容。我遇到的问题是:

  • 我必须单击“是”以覆盖先前的回归数据,该数据在每张纸中的范围为$ S $ 33。我以为Application.DisplayAlerts = False可以解决此问题。
  • 每个月范围都会变化。它总是从$ L $ 2和$ C $ 2开始,但是需要用到上个月。 (请参见下面突出显示的部分),因为现在是6月19日,所以它的取值范围应从$ L $ 2到$ L $ 43和$ C $ 2到$ C $ 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

enter image description here

2 个答案:

答案 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文件中),您也不会对此无能为力。