回帰繰り返し

Question

説明変数をA列に固定し，B列以降を目的変数として回帰分析を繰り返す処理をVBAやマクロ，Rなどで自動化できるか教えて頂きたいです。

Answer 1

> データタブのデータ分析→回帰分析で> > 入力X範囲はA列のデータで固定，> 入力Y範囲をB,C...と1列ずつ変えるのを自動化したい

（標準モジュール）

Sub RunRegressionByAnalysisToolPack()
On Error GoTo Err_RunRegressionByAnalysisToolPack

    Dim addAnalysis As Excel.AddIn
    Dim strATPVBA As String
    
    Set addAnalysis = LoadAddIn("分析ツール")
    If addAnalysis Is Nothing Then
        Exit Sub
    End If
    Set addAnalysis = Nothing

    Set addAnalysis = LoadAddIn("分析ツール - VBA")
    If addAnalysis Is Nothing Then
        Exit Sub
    End If
    strATPVBA = addAnalysis.Name
    Set addAnalysis = Nothing
    
    Dim wbkSource As Excel.Workbook
    Dim wbkDestination As Excel.Workbook
    Dim wsSource As Excel.Worksheet
    Dim wsDestination As Excel.Worksheet
    Dim rngInputRangeX As Excel.Range
    Dim rngInputRangeY As Excel.Range
    Dim lngFirstRow As Long
    Dim lngLastRow As Long
    Dim lngColumnX As Long
    Dim lngColumnY As Long
    Dim lngFirstColumnY As Long
    Dim lngLastColumnY As Long
    Dim lngSheetCount As Long
    
    Set wbkSource = ActiveWorkbook
    Set wsSource = wbkSource.ActiveSheet
    
    With wsSource
        lngFirstRow = 1
        lngColumnX = 1
        lngLastRow = .Cells(.Rows.Count, lngColumnX).End(xlUp).Row
        If lngFirstRow > lngLastRow Then
            Set wsSource = Nothing
            Set wbkSource = Nothing
            Exit Sub
        End If
        
        lngFirstColumnY = lngColumnX + 1
        lngLastColumnY = .Cells(lngFirstRow, .Columns.Count).End(xlToLeft).Column
        If lngFirstColumnY > lngLastColumnY Then
            Set wsSource = Nothing
            Set wbkSource = Nothing
            Exit Sub
        End If
    
        Set rngInputRangeX = .Range(.Cells(lngFirstRow, lngColumnX), _
                                    .Cells(lngLastRow, lngColumnX))

        Set wbkDestination = Workbooks.Add
        lngSheetCount = 0

        For lngColumnY = lngFirstColumnY To lngLastColumnY
            
            Set rngInputRangeY = .Range(.Cells(lngFirstRow, lngColumnY), _
                                        .Cells(lngLastRow, lngColumnY))
            
            With wbkDestination.Worksheets
                lngSheetCount = lngSheetCount + 1
                If lngSheetCount > .Count Then
                    Set wsDestination = .Add(After:=.Item(.Count))
                Else
                    Set wsDestination = .Item(lngSheetCount)
                End If
                wsDestination.Name = "atp_" & rngInputRangeY.Cells(1, 1).Text
            End With
            
            Application.Run strATPVBA & "!Regress", _
                            rngInputRangeY, rngInputRangeX, _
                            False, True, , _
                            wsDestination.Cells(1, 1), _
                            False, False, False, _
                            False, , False
                                
            wsDestination.UsedRange.EntireColumn.AutoFit
        
            Set rngInputRangeY = Nothing
            Set wsDestination = Nothing
        Next
    
    End With
    
    Application.DisplayAlerts = False
    With wbkDestination.Worksheets
        Do While .Count > lngSheetCount
            .Item(.Count).Delete
        Loop
        .Item(1).Select
    End With

Exit_RunRegressionByAnalysisToolPack:
On Error Resume Next
    
    Application.DisplayAlerts = True
    
    Set addAnalysis = Nothing
    Set wsDestination = Nothing
    Set wbkDestination = Nothing
    Set rngInputRangeY = Nothing
    Set rngInputRangeX = Nothing
    Set wsSource = Nothing
    Set wbkSource = Nothing

    Exit Sub

Err_RunRegressionByAnalysisToolPack:

    Dim strMsg As String
    
    strMsg = "実行時エラー " & Err.Number & ": " & Err.Description
    Debug.Print strMsg
    
    MsgBox strMsg, vbCritical, "実行時エラー（RunRegressionByAnalysisToolPack）"
    
    Resume Exit_RunRegressionByAnalysisToolPack
End Sub
 
Function LoadAddIn(AddInName As String)
On Error GoTo Err_LoadAddIn

    Dim AddIn As Excel.AddIn
    
    Set AddIn = Application.AddIns(AddInName)
        
    With AddIn
        
        If .Installed = False Then
            .Installed = True
        End If
        If .IsOpen = False Then
            Workbooks.Open .FullName
        End If
        
    End With
    
    Set LoadAddIn = AddIn
    
Exit_LoadAddIn:
    
    Exit Function
    
Err_LoadAddIn:
On Error Resume Next
    
    Dim strMsg As String
    
    strMsg = "実行時エラー " & Err.Number & ": " & Err.Description
    Debug.Print strMsg

    strMsg = "[" & AddInName & "]を読み込むことが出来ません。" & vbCrLf & vbCrLf & _
             String(30, "-") & vbCrLf & vbCrLf & _
             strMsg & vbCrLf & vbCrLf & _
             String(30, "-")
    
    MsgBox strMsg, vbCritical, "アドイン読込エラー（LoadAddIn）"
    
    Set AddIn = Nothing
    
    Resume Exit_LoadAddIn
End Function

---

以上のようなコードを実行できればよい、ということでしょうか。

Answer 2

学校の課題で苦戦していたので本当にありがとうございます！

シート名が同じ時に作業が止まってしまうのですが，

同じファイル名の時に　例えば○○１，〇○２...のようにするには

プログラムのどこを変更すればよいのでしょうか

Answer 3

データタブのデータ分析→回帰分析で

入力X範囲はA列のデータで固定，

入力Y範囲をB,C...と1列ずつ変えるのを自動化したいです。

よろしくお願いします。

Answer 4

「自動化できるか」という質問に対しては、VBA（ここは Excel のコミュニティなのでマクロと同義）で実現できる可能性はかなり高いと考えます。R に関しては知ったこっちゃありませんが。

　ただしやりたいことをもっと具体的に書いてくれないことには、「こうすればできます」というアドバイスは得られにくいでしょう。