• ベストアンサー

組み合わせを抽出するために使う再帰呼び出しについて

1,2,3,4,5の数列から3の数の組合せをワークシートに表示するプログラムを作っています。 このソースは以前他の質問に載っていたものを自分用に多少アレンジしたものです。構造は再帰呼び出しを使って、123、124、125、134、135、145、234、235…345という形で結果を出力します。いろいろと試してみて、計算結果は正しいとわかったのですが、デバックをしていて1つどうしても理解できないことがありました。計算結果が145から234になるとき、カーソルがSub combiPrのEnd subを指したあと直前のEnd ifに移ります。その後Forに移って234以降の計算を始めます。どうしてEnd Subからこのような動作をするのかわかる方いらっしゃいましたら是非ワケを教えてください。よろしくお願いしますm(_ _)m Const m As Integer = 3 '←取り出す個数 Const n As Integer = 5 '←サンプル数 Dim rStr As String Dim mRow As Integer Dim Nest As Integer Dim A(10) As Variant Sub combi() Cells.ClearContents mRow = 0 Nest = 0 combiPr (0) End Sub Sub combiPr(n1) Dim mCol As Integer For nn = n1 + 1 To n - m + Nest + 1 Nest = Nest + 1 A(Nest) = nn If Nest = m Then mRow = mRow + 1 For mCol = 1 To m Worksheets(1).Cells(mRow, mCol).Value = A(mCol) Next Else Call combiPr(nn) End If Nest = Nest - 1 Next nn End sub

質問者が選んだベストアンサー

  • ベストアンサー
noname#102340
noname#102340
回答No.2

p1(プログラム1)がp2を呼び出し、p2がp3を呼び出し、という再帰呼び出しをビジュアルで書くと下。 p1始 p2始 p3始 p3終 p2終  p1終 提示されたソースでいうと下(だと思う)。 組み合わせの1桁目をセットするプログラム(プロシージャ)をcombiPr1と書くことにする。 combiPr2が、combiPr3を呼び出しcombiPr3が答えを出力して終了(End Sub)、combiPr2のcombiPr3呼び出し行に戻る。

akiy38
質問者

お礼

なるほど!わかりやすい御説明ありがとうございました。私の再帰呼び出し文の理解が不十分だったようです。呼び出す前のプロシージャが生きていることを忘れていました。ありがとうございました。

その他の回答 (1)

  • bin-chan
  • ベストアンサー率33% (1403/4213)
回答No.1

デバッグ時に、呼び出し履歴を参照してみるとわかるかも。 メニューの表示>ツールバ>デバッグをクリック。 で、「呼び出し履歴」で、「どの行から呼ばれているか」が参照できると思います。

akiy38
質問者

お礼

初めて知りました。とても便利な機能だと思います。ただ、再帰プログラムにトレースは、私にはややこしすぎました(ToT)ありがとうございました。

関連するQ&A

  • エクセルマクロでEnd Subが見つからないとでる

    Excelのマクロ記述についての質問です.  以下のマクロはエクセルにない関数「IMMULT」をあらかじめ定義するためのものです.(技術計算のHPより入手し,コピーして貼り付けたものです)  これを実行すると「End Subがみつからない」と出てしまいます.End Subは記述しているのになぜでしょうか,どなたか解決策を教えて頂けませんか! Sub 関数定義() Public Function IMMULT(a As Range, b As Range) As Variant Dim r1 As Integer, r2 As Integer, c1 As Integer, c2 As Integer, nn As Integer Dim r As Integer, c As Integer Dim cr As Integer, cc As Integer Dim n As Integer Dim mm() As Variant r1 = a.Rows.Count r2 = b.Rows.Count c1 = a.Columns.Count c2 = b.Columns.Count If (c1 = r2) Then nn = c1 Else Exit Function End If cr = r1 cc = c2 ReDim mm(1 To cr, 1 To cc) For r = 1 To cr For c = 1 To cc mm(r, c) = 0 For n = 1 To nn mm(r, c) = IMSUMa(mm(r, c), IMPRODUCTa(a.Cells(r, n), b.Cells(n, c))) Next Next Next IMMULT = mm End Sub

  • vba boolean変数を開放する方法

    エクセルのセルに「○○○○○○○○○○××××××××××」と入っているものをランダムに並べ代えるマクロを探してみました。 Sub macro2() Dim i, m As Integer Dim b, c As String Dim flg(1 To 20) As Boolean b = Cells(1, 1).Value Randomize For i = 1 To 20 Do m = Int(20 * Rnd + 1) If flg(m) = False Then flg(m) = True Exit Do End If Loop c = c & Mid(b, m, 1) Next i Cells(1, 2).Value = c End Sub これはうまく動くのですが、10行分やろうとして、以下のように変更すると暴走(終わらない)します。 Sub macro2() Dim i, m, n As Integer Dim b, c As String Dim flg(1 To 20) As Boolean For n = 1 To 10 b = Cells(n, 1).Value Randomize For i = 1 To 20 Do m = Int(20 * Rnd + 1) If flg(m) = False Then flg(m) = True Exit Do End If Loop c = c & Mid(b, m, 1) Next i Cells(n, 2).Value = c next n End Sub 一行目が終わってもboolean変数の値がそのまま残っているのが原因らしいのですが開放する方法がわかりません。 取りあえずもう一つマクロを追加してやりたいことはできたのですが、 Sub macro1() Dim n As Integer For n = 1 To 10 Call macro2(n) Next n End Sub Sub macro2(n As Variant) 以下略 なんかスッキリしません。 boolean変数を開放し、マクロひとつですます方法を教えて頂きたくお願いします。 flg(m) = Falseを挿入してもダメでした。

  • VBAで行列を作る方法

    次のようなプログラミングで1,0,-1の要素で作られる3×3行列を全通り調べています。 この場合3の9乗通り調べることができます。 これを4×4や5×5行列など数を大きくして調べたいのですが、このプログラムを配列を使うなどして 簡単にできる方法を教えてください。 よろしくおねがいします。 Sub test() Dim a As Integer '行 Dim b As Integer '列 Dim c As Integer, i As Integer, j As Integer, d As Integer, e As Integer Dim 内積 As Integer, step As Integer Dim f As Integer, g As Integer, h As Integer, l As Integer, m As Integer, n As Integer, k As Integer, x As Integer Dim sum As Integer, total As Integer Dim aa As Integer, aaa As Integer, aaaa As Integer, bb As Integer, bbb As Integer, bbbb As Integer a = 3 '行 b = 3 '列 c = 0 内積 = 0 con = 0 sum = 0 tatal = 0 aa = 0 aaa = 0 aaaa = 0 bb = 0 bbb = 0 bbbb = 0 x = 0 For n = 0 To 2 For m = 0 To 2 For l = 0 To 2 For k = 0 To 2 For h = 0 To 2 For g = 0 To 2 For f = 0 To 2 For e = 0 To 2 For d = 0 To 2 '要素がすべて1 For i = 1 To a For j = 1 To b Cells(i, j) = 1 Next j Next i If bbbb = 1 Then Cells(a - 2, b - 2) = 0 ElseIf bbbb = 2 Then Cells(a - 2, b - 2) = -1 End If If bbb = 1 Then Cells(a - 1, b - 2) = 0 ElseIf bbb = 2 Then Cells(a - 1, b - 2) = -1 End If If bb = 1 Then Cells(a, b - 2) = 0 ElseIf bb = 2 Then Cells(a, b - 2) = -1 End If If aaaa = 1 Then Cells(a - 2, b - 1) = 0 ElseIf aaaa = 2 Then Cells(a - 2, b - 1) = -1 End If If aaa = 1 Then Cells(a - 1, b - 1) = 0 ElseIf aaa = 2 Then Cells(a - 1, b - 1) = -1 End If If aa = 1 Then Cells(a, b - 1) = 0 ElseIf aa = 2 Then Cells(a, b - 1) = -1 End If If total = 1 Then Cells(a - 2, b) = 0 ElseIf total = 2 Then Cells(a - 2, b) = -1 End If If sum = 1 Then Cells(a - 1, b) = 0 ElseIf sum = 2 Then Cells(a - 1, b) = -1 End If If con = 1 Then Cells(a, b) = 0 ElseIf con = 2 Then Cells(a, b) = -1 End If con = con + 1 Next d con = 0 sum = sum + 1 Next e sum = 0 total = total + 1 Next f total = 0 aa = aa + 1 Next g aa= 0 aaa = aaa + 1 Next h aaa = 0 aaaa = aaaa + 1 Next k aaaa = 0 bb = bb + 1 Next l bb = 0 bbb = bbb + 1 Next m bbb = 0 bbbb = bbbb + 1 Next n End Sub

  • エクセルマクロで定義した関数が動きません

    以前にマクロの記述について教えて頂いた件の続きになります. ご指導頂いたとおりExcelマクロで複素数を扱う関数を下記HPから 標準モジュールにコピペしました.今度は正しくコピーできたと思いますが, 実行するとエラーになります. 標準の組込み関数を用いて「実数」の行列を計算すれば正しく 計算できますが,当然ながら「複素数」は計算できません. この「複素数」を扱う新しく定義した関数が動かない理由, 「End if に対するifブロックがありません」とか 計算結果が「#VALUE!」となってしまうのは何故でしょうか? マクロの記述内容はほとんど理解できないのですが, どなたか助けて頂けませんか! ちなみにエクセルは2016版です. http://www.geocities.jp/tomtomf/denki/AC2/ac2.htm http://www.geocities.jp/tomtomf/denki/AC1/ac1.htm 以下はコピー定義した「 IMMULT」関数と「 IMINVERS」関数のマクロです. Public Function IMMULT(a As Range, b As Range) As Variant Dim r1 As Integer, r2 As Integer, c1 As Integer, c2 As Integer, nn As Integer Dim r As Integer, c As Integer Dim cr As Integer, cc As Integer Dim n As Integer Dim mm() As Variant r1 = a.Rows.Count r2 = b.Rows.Count c1 = a.Columns.Count c2 = b.Columns.Count If (c1 = r2) Then nn = c1 Else Exit Function End If cr = r1 cc = c2 ReDim mm(1 To cr, 1 To cc) For r = 1 To cr For c = 1 To cc mm(r, c) = 0 For n = 1 To nn mm(r, c) = IMSUMa(mm(r, c), IMPRODUCTa(a.Cells(r, n), b.Cells(n, c))) Next Next Next IMMULT = mm End Function Public Function IMINVERS(a As Range) As Variant Dim n As Integer, n1 As Integer, n2 As Integer Dim r1 As Integer, r2 As Integer, c As Integer Dim max As Variant Dim i As Integer Dim m() As Variant Dim inm() As Variant Dim rr As Integer, cc As Integer Dim no As Integer, ex As Variant n1 = a.Rows.Count n2 = a.Columns.Count n = n1 ReDim inm(1 To n1, 1 To n2) For rr = 1 To n1 For cc = 1 To n2 If rr <> cc Then inm(rr, cc) = 0 Else inm(rr, cc) = 1 'End If Next Next ReDim m(1 To n1, 1 To n2) m = a If n1 <> n2 Then IMINVERS = False Exit Function End If For r1 = 1 To n max = m(r1, r1) no = r1 If r1 < n Then For i = r1 + 1 To n If IMABSa(m(i, r1)) > IMABSa(max) Then max = m(i, r1) no = i End If Next If (r1 <> no) Then For i = 1 To n ex = m(r1, i) m(r1, i) = m(no, i) m(no, i) = ex Debug.Print m(r1, i), m(no, i) ex = inm(r1, i) inm(r1, i) = inm(no, i) inm(no, i) = ex Next End If End If max = m(r1, r1) For i = 1 To n m(r1, i) = IMDIVa(m(r1, i), max) inm(r1, i) = IMDIVa(inm(r1, i), max) Next For r2 = 1 To n If r1 <> r2 Then max = m(r2, r1) For i = 1 To n m(r2, i) = IMSUBa(m(r2, i), IMPRODUCTa(m(r1, i), max)) inm(r2, i) = IMSUBa(inm(r2, i), IMPRODUCTa(inm(r1, i), max)) Next End If Next Next IMINVERS = inm End Function

  • エクセルVBAで、特定の数字になる組み合わせを知りたいのですが・・・

    A.5380、B.4730、C.3310、D.2840、E.2360、F.1890、G.1420、H.940 以上8種類の数字を組み合わせて、合計13010ちょうどになる組み合わせをすべて知りたいです。8種類の数字は、同じものを何度組み合わせても構いません。 例えば、A+A+B=○のようにです。 色々自分なりに調べたところ、ソルバーで試してみましたが、組み合わせの数字が複雑な為か、解答はでませんでした。 また、VBAを使用して以下のような例が掲載されていたので試してみましたが、オーバーフローしてしまって答えがでません。 VBAがまったくの初心者のため、どのようにしたら問題が解消されるのかわかりません。 どなたか教えていただけませんでしょうか。お願いします。 ' knapsack総当たり ' 目標値と一致する物をすべて求める ' 'by S. Tada Const N = 8 ' データの数 Dim wa(N) As Long Sub knap_main() Dim w As Long, wmax As Long Dim i As Integer, j As Long, k As Integer Dim y1 As Integer, y2 As Integer Dim b As Long y1 = 1 ' A1:Anにデータを入れておく y2 = y1 + 1 ' B列以降が結果 For i = 1 To N wa(i) = Cells(i, y1).Value Next wmax = Cells(45, y1).Value ' A45に目標値を入れておく For j = 1 To 2 ^ N - 1 w = 0 b = 1 For k = 1 To N If j And b Then w = w + wa(k) b = b + b Next If w = wmax Then b = 1 For k = 1 To N If j And b Then Cells(k, y2).Value = wa(k) b = b + b Next y2 = y2 + 1 End If Next End Sub

  • 以前に回答いただいたVBAですが、理解できない部分があったので、抜粋し

    以前に回答いただいたVBAですが、理解できない部分があったので、抜粋して質問に投稿したところ、多くの方々から、「これでは、わからない」などの指摘をいただき、これでは、以前に回答していただいた回答者様の名誉にかかわると思い全文を記載させていただくことにしました。  あわせて、この、VBAの詳しい説明を快くしていただける方は回答よろしくお願いします。以下のとうりです。  A列  B列 1 期間  90 2 人数  21 3 4 氏名  回数 5 A   23 6 B   23 7 C   19 8 D   16 9 E   12 10 F   9 11 G   8 12 H   7 13 I   7 14 J   6 15 K   6 16 L   6 17 M   5 18 N   5 19 O   4 20 P   4 21 Q   4 22 R   4 23 S   4 24 T   4 25 U   4 Sub 当番割当() Dim 期間 As Integer Dim 人数 As Integer Dim 氏名() As String Dim 回数() As Integer Dim i As Integer Dim j As Integer Dim k As Integer Dim m As Integer Dim n As Integer Dim n1 As Integer Dim n2 As Integer Dim p As Single Dim q As Single Dim 当番() As String Dim 担当() As Single 期間 = Cells(1, 2) 人数 = Cells(2, 2) ReDim 氏名(人数) ReDim 回数(人数) For i = 1 To 人数 氏名(i) = Cells(4 + i, 1) 回数(i) = Cells(4 + i, 2) Next i ReDim 当番(期間 * 2) ReDim 担当(期間 * 2) n = 0 For i = 1 To 人数 n1 = 0 n2 = 0 For j = 1 To 人数 If 回数(j) = 回数(i) Then n1 = n1 + 1 If j <= i Then n2 = n2 + 1 End If Next j p = 期間 / 回数(i) For j = 1 To 回数(i) q = p * (n2 - 0.5) / n1 + p * (j - 1) m = 1 For k = n To 1 Step -1 If 担当(k) <= q Then m = k + 1 Exit For End If 当番(k + 1) = 当番(k) 担当(k + 1) = 担当(k) Next k 当番(m) = 氏名(i) 担当(m) = q n = n + 1 Next j Next i Range("E:G").Clear For n = 1 To 期間 Cells(n, 5) = n & "日" Cells(n, 6) = 当番(n * 2 - 1) Cells(n, 7) = 当番(n * 2) Next n End Sub

  • Excel VBAライフゲーム

    ExcelのVBAでライフゲームを作りたいのですが、次のプログラムの途中以降がわかりません。 もしよろしければ、このつづきの簡単な実行できるVBAライフゲームを教えてください。 続きのプログラムを教えていただけたら幸いです。 Option Explicit Const ALIVE As Integer = 1 Const DEAD As Integer = 0 Const SIZE As Integer = 19 Const Tmax As Integer = 100 Dim C(SIZE, SIZE) As Integer Sub LifeGame() Dim InitRate As Single Dim T As Integer Dim N As Integer Dim Cnext(SIZE, SIZE) As Integer Dim I As Integer, J As Integer InitRate = -1 Do While InitRate < 0 Or 1 < InitRate Loop For I = 0 To SIZE For J = 0 To SIZE If Rnd() < InitRate Then C(I, J) = ALIVE Else C(I, J) = DEAD End If Next J Next I For T = 1 To Tmax For I = 0 To SIZE For J = 0 To SIZE If C(I, J) = ALIVE Then Cells(I + 1, J + 1).Value = "■" Else Cells(I + 1, J + 1).Vallue = "" End If Next J Next I For I = 0 To SIZE For J = 0 To SIZE N = Count(I, J) Next J Next I For I = 0 To SIZE For J = 0 To SIZE C(I, J) = Cnext(I, J) Next J Next I Next T End Sub Function Count(I As Integer, J As Integer) As Integer End Function

  • 擬似マインスイーパー

    任意の地雷を設置するというプログラムです。 この中で地雷を*に、安全地帯を空白にしたいのですがやり方がわからないので、わかる方お願いします。 Sub mine() Dim minefield(11, 13) As Integer Dim i As Integer, a As Integer, b As Integer Dim c As Integer c = InputBox("地雷の数を決めます") Randomize For i = 1 To c a = Int(Rnd * 10) + 1 b = Int(Rnd * 12) + 1 If minefield(a, b) = 9 Then i = i - 1 minefield(a, b) = 9 Next i countMine minefield, 10, 12 showInt minefield, 10, 12 ' show minefield, 10, 12 End Sub Sub countMine(f() As Integer, h As Integer, w As Integer) Dim i As Integer, j As Integer Dim a As Integer, b As Integer Dim x As Integer For a = 1 To 10 For b = 1 To 12 If f(a, b) < 9 Then x = 0 If f(a, b - 1) = 9 Then x = x + 1 '左に地雷があるか If f(a, b + 1) = 9 Then x = x + 1 '右に地雷があるか ' ... この部分に追加したいのだが ... f(a, b) = x End If Next b Next a End Sub Sub showInt(f() As Integer, h As Integer, w As Integer) Dim i As Integer Const a As Integer = 7 Const b As Integer = 3 Do While h > 0 For i = 1 To w Cells(a + h, b + i) = f(h, i) Next i h = h - 1 Loop End Sub

  • VBAで縦一列に数字を入力したい

    Private Sub CommandButton1_Click() Dim n As Integer Dim i As Integer Dim x As Integer For i = 1 To n x = i + 3 n = InputBox("層数の値を入力してください") Cells(3, 1).Value = ("基板") Cells(x, 1).Value = i x = x + 1 Next End Sub 上記のようなマクロを組んだのですが、4行目に1が入ってとまってしまいました。 これを完成させるにはどうしたらいいでしょうか?

  • 単純な掛け算なのにわけのわからない小数点が、、、

    表題のとおりですが、EXCEL VBAでシートと複合させて計算したところ次のような結果が出ました。 マクロは以下のとおりです。 Private Sub CommandButton1_Click()  Dim i As Integer Dim n As Integer Dim x As Integer Dim y As Single  Dim d1 As Single Dim d2 As Single  n = Range("L4").Value 'L4には現在399が入力されています。 y = Range("L2").Value 'L2には現在0.048が入力されています。  d1 = Range("D11").Value d2 = Range("E11").Value If n = 0 Then Exit Sub For i = 0 To n x = i + 6 Cells(x, 13) = i Cells(x, 14) = Cells(x, 13) * y Cells(x, 15) = Cells(x, 14) + d1 Cells(x, 16) = d2 - Cells(x, 14)     x = x + 1 Next i End Sub こうするとCells(7, 14)に0.0480000004172325という数字が入り始め、 続きも同じように小数点の小さい桁にわけの分からない数字が出て来ます。いったい何が原因か分かりません。 よろしくお願いします。

専門家に質問してみよう