Анализ временных рядов в Excel с использованием VBA - PullRequest
0 голосов
/ 05 июня 2019

У меня есть рабочая книга объемом до 103 листов.

  • 101 лист будет иметь различный объем продукта для анализа временных рядов.
  • Существует вкладка данных RAW, из которой каждыйлист будет извлекать данные начального объема.
  • Существует сводный лист, составленный для получения прогноза на 12 месяцев для всех 101 наименований.

Я хочу выполнить цикл из листа 3103 и автоматизировать анализ данных, регрессионную часть анализа временных рядов, чтобы обновить данные временных рядов на сводном листе.

Я создал код ниже, чтобы показать, что я пробовал.Проблема, которую я получаю:

  • Я должен нажать «Да», чтобы перезаписать предыдущие данные регрессии, которые находятся в диапазоне $ S $ 33 на каждом листе.Я думал, что Application.DisplayAlerts = False исправит это.
  • Каждый месяц диапазоны будут меняться.Он всегда будет начинаться с $ L $ 2 и $ C $ 2, однако должен быть уменьшен до предыдущего месяца.(Пожалуйста, см. Выделенное ниже). Сейчас мы находимся в 19 июня, поэтому он должен варьироваться от $ L $ 2 до $ L $ 43 и от $ C $ 2 до $ C $ 43, поскольку строка 43 - это линия 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 ]

1 голос
/ 05 июня 2019

Не было времени ответить раньше ... это еще один способ сделать это:

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

К сожалению, это окно сообщения встроено в саму надстройку, и даже если у вас есть пароль для надстройки (Wildebeest!!), учитывая, что фактическая функция хранится в файле ANALYS32.XLL), вы не сможете делать с этим многое.

1 голос
/ 05 июня 2019

Диапазоны могут быть установлены программно, и вы можете ссылаться на них с помощью переменной вместо 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-существующих-data-alert-in-vba-macro ATPVBAEM выглядит игнорирующим / перезаписывающим DisplayAlert параметр.

РЕДАКТИРОВАТЬ: поиск последней строки исправлен, спасибо @ ja72

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...