VBAでの回帰

Question

以前ここで，2列目以降を1列目で固定して回帰する　以下のVBAを書いていただいたのですが，

2列目以降の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 1

> 以前ここで，2列目以降を1列目で固定して回帰する　以下のVBAを書いていただいたのですが

回帰繰り返し

> 2列目以降の1行目が同じ数字が続くと実行時エラーが出て作業が止まります．
実行時エラーが発生している箇所については shasano さんが回答された通り。

ただ、どこをどのように直すか/直さないか以前の問題として、
まずどのようなレイアウトの表を使って回帰分析を行なうのかについて
より具体的に明記するようにして下さい。

恐らく、列見出し（ラベル）行がない表を使って
回帰分析を行なおうとされているのではないでしょうか。

> Application.Run strATPVBA & "!Regress", _> rngInputRangeY, rngInputRangeX, _> False, True*, , _> wsDestination.Cells(1, 1), _> False, False, False, _> False, , False*

上記のステートメントにおいて分析ツールの Regress メソッドを呼び出す際、
Regress メソッドの第 4 引数 labels に対して True を渡しています。

これは[入力 Y 範囲]および[入力 X 範囲]として指定されたそれぞれの範囲の
最初のセルをラベルとして扱って回帰分析を実行するということです。

もし[入力 Y 範囲]および[入力 X 範囲]にラベルが含まれていない
（全てのセルが分析の対象である）のであれば、そのまま実行しても
最初のセルが無視されてしまうため、正確な分析結果は得られません。

> 例えばタブ名を０，０（１），０（２）...　のようにするには> どこを書き換えればよいのでしょうか．

また、Regress メソッドによって作成されたワークシートには、
Y 範囲のラベルの値がどこにも出力されません。

仮にそういうリネーム処理を行なった場合、それぞれのシートの内容が
どの列を入力 Y 範囲とした回帰分析の結果を表しているのかが
大変分かりにくくなるでしょう。

Answer 2

ご回答ありがとうございます。

1行目がラベルになることに気付かずマクロを使っていたので，問題解決しました．　

助かりましたm(__)m

Answer 3

修正すべきは以下の一行でしょう。

wsDestination.Name = "atp_" & rngInputRangeY.Cells(1, 1).Text

　ただしもともと自分が書いたマクロではなく、局所的にしかコードを見ていないので、ここだけ変えればよいとは断言しかねます。

　どう修正するかは頑張って考えてみてください。同じ数字が「連続する」場合だけでなく、既出の数字と同じものがあれば同様にエラーになりますから、

> 例えばタブ名を０，０（１），０（２）...

の通りにするのはそう簡単ではなく、労多くして功少なしな気がします。単純に連番にするなら簡単でしょうが。