Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


75522 / 76738 ←次へ | 前へ→

【5652】Re:値がゼロになってしまってコマッタ
回答  ゆと  - 03/5/23(金) 18:40 -

引用なし
パスワード
   さくらさん、Jakaさん こんにちは。
とりあえず、プログラムの動作しない原因はJakaさんの仰るように
指定が違うからではないでしょうか。

変数への代入の部分を書き換えただけのものを書いておきます。
また、ちょっと興味があったので拡張性を持たせた(?)ものも作っ
てみたので、載せてみます。普通は再帰を使うところなのに、使わ
ずに組んでしまった力技ではありますが(苦笑)
一応投稿の初期条件の通り、1行目に値、2行目に○が入った場
合の数の組み合わせ条件を出力してくれるはずです。
変数名を適当に付けすぎたので、ちょっと見難いかも。

Sub sample0()
Dim A&(1 To 7), i%
For i% = 1 To 7
  If Cells(2, i%).Value = "○" Then A&(i%) = Cells(1, i).Value
Next i%

kazu = 5

For i = 1 To 2
For j = i + 1 To 3
 For k = j + 1 To 4
  For l = k + 1 To 5
  For m = l + 1 To 6
   For n = m + 1 To 7
 
  
   kazu = kazu + 1
 
 
   If kazu < 100 Then
 
    Cells(kazu, 1) = A(i)
    Cells(kazu, 2) = A(j)
    Cells(kazu, 3) = A(k)
    Cells(kazu, 4) = A(l)
    Cells(kazu, 5) = A(m)
    Cells(kazu, 6) = A(n)
 
  
   End If
 
   Next
  Next
  Next
 Next
Next
Next

End Sub

Sub sample1()
Dim A&(), i%, j%, k%, l%, EColumn%, OutCnt%, OutRow&, Patarn%
Dim ans(), FLG As Boolean
OutRow& = 5: k% = 1
OutCnt% = Application.InputBox("抜き取り数を指定してください")
j% = Application.CountIf(Rows(2), "○")

If j% <> 0 Then
  ReDim A&(1 To j%)
  EColumn% = Cells(1, 256).End(xlToLeft).column
  For i% = 1 To EColumn
    If Cells(2, i%).Value = "○" Then
      A&(k%) = Cells(1, i%).Value
      k% = k% + 1
    End If
  Next i%
  If OutCnt% <= j% Then
    Patarn% = Application.Combin(j%, OutCnt%)
  Else
    MsgBox "抜き取り数が正しくありません"
    End
  End If
  ReDim ans(1 To Patarn%, 1 To OutCnt%)
  For k% = 1 To j%
    FLG = False
    For i% = 1 To j% - 1
      If A(i%) > A(i + 1) Then
        temp = A(i%)
        A(i%) = A(i% + 1)
        A(i% + 1) = temp
        FLG = True
      End If
    Next i%
    If FLG = False Then Exit For
  Next k%
  For i% = 1 To OutCnt%
    ans(1, i%) = i%
  Next i%
  For i% = 2 To Patarn%
    For k% = OutCnt% To 1 Step -1
      If ans(i% - 1, k%) + 1 <= j% - OutCnt% + k% Then
        For l% = 1 To OutCnt%
          If l% < k% Then
            ans(i%, l%) = ans(i% - 1, l%)
          Else
            If l% = k% Then
              ans(i%, l%) = ans(i% - 1, l%) + 1
            Else
              ans(i%, l%) = ans(i%, l% - 1) + 1
            End If
          End If
        Next l%
        Exit For
      End If
    Next k%
  Next i%
  For i% = 1 To Patarn%
    For k% = 1 To OutCnt%
      ans(i%, k%) = A(ans(i%, k%))
    Next k%
  Next i%
  Range(Cells(OutRow&, 1), Cells(OutRow& + Patarn% - 1, OutCnt%)).Value = ans()
End If
End Sub

4 hits

【5635】値がゼロになってしまってコマッタ さくら 03/5/23(金) 10:50 質問
【5639】Re:値がゼロになってしまってコマッタ Jaka 03/5/23(金) 14:03 回答
【5644】Re:値がゼロになってしまってコマッタ さくら 03/5/23(金) 17:00 質問
【5652】Re:値がゼロになってしまってコマッタ ゆと 03/5/23(金) 18:40 回答
【5655】Re:値がゼロになってしまってコマッタ さくら 03/5/23(金) 20:03 質問
【5656】Re:値がゼロになってしまってコマッタ ゆと 03/5/23(金) 20:14 発言
【5658】Re:値がゼロになってしまってコマッタ さくら 03/5/23(金) 20:57 質問
【5659】Re:値がゼロになってしまってコマッタ ゆと 03/5/23(金) 21:13 発言
【5665】Re:値がゼロになってしまってコマッタ さくら 03/5/26(月) 23:01 お礼

75522 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free