| |
さくらさん、Jakaさん こんにちは。
とりあえず、プログラムの動作しない原因はJakaさんの仰るように
指定が違うからではないでしょうか。
変数への代入の部分を書き換えただけのものを書いておきます。
また、ちょっと興味があったので拡張性を持たせた（？）ものも作っ
てみたので、載せてみます。普通は再帰を使うところなのに、使わ
ずに組んでしまった力技ではありますが(苦笑)
一応投稿の初期条件の通り、1行目に値、２行目に○が入った場
合の数の組み合わせ条件を出力してくれるはずです。
変数名を適当に付けすぎたので、ちょっと見難いかも。
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
|
|
- 03/5/23(金) 21:13 -
