| |
▼さくら さん：
こんにちは。
>説明です
> C3に1 D3に2 E3に3 F3に4 G3に5 H3に6
> C4に7 D4に8 E4に9 F4に10 と数字入力します。
>
> そしてC7.D7.E7.F7.G7から組合せ
> 1, 2, 3, 4, 5
> 1, 2, 3, 4, 6
> 1, 2, 3, 4, 7
> 1, 2, 3, 4, 8
> 1, 2, 3, 4, 9
> 1, 2, 3, 4,10
> : : : : :
> 5, 7, 8, 9,10
> 6, 7, 8, 9,10
>
>上記はC3〜F4を、10個と固定した時の組合せですが、
>数字入力が5個のときや、6個、7個、8個、9個でも、くみあわせ出来るように
>したいのですが、いまいちわからないので教えてください。
>
>おしえてください・・。
>
>よろしくおねがいします。
じっくりデバッグしてないんで、確認はして下さい
'==========================================================
Sub test()
Dim ans()
Dim 抜き取り As Long
抜き取り = 5
' ↑の数字を6個、7個、8個、9個に変えてください
cmb = comb(ans(), Range("C3:H3,C4:F4"), 抜き取り)
Range(Cells(7, 4), Cells(cmb + 6, 4 + 抜き取り - 1)).Value = ans()
MsgBox "以上" & cmb & "通りのリストです"
End Sub
'===========================================================
Function comb(ans(), Optional rng As Range = Nothing, Optional seln As Long = 0, Optional ByVal myx As Long = 0, Optional ByVal ctx As Long = 0) As Long
'input rng : 組み合わせメンバーセル範囲
' seln: 抜き取り数
'out ans() 組み合わせリスト
' mxy ctx は 内部パラメータ指定不可
Dim crng As Range
Static svn As Long
Static myarray()
Static idx As Long
Static gyou As Long
Static mylim As Long
Dim cnt As Long
If seln > 0 Then
svn = seln
Erase myarray
i = 1
For Each crng In rng
ReDim Preserve myarray(1 To i)
myarray(i) = crng.Value
i = i + 1
Next
mylim = rng.Count
myx = 1
gyou = WorksheetFunction.Combin(rng.Count, seln)
comb = gyou
ReDim ans(1 To gyou, 1 To svn)
ctx = 1
idx = 1
End If
cnt = 0
Do While myx <= mylim And idx <= gyou
If cnt > 0 And idx > 1 Then
For i = 1 To ctx - 1
ans(idx, i) = ans(idx - 1, i)
Next
End If
ans(idx, ctx) = myarray(myx)
If ctx + 1 <= svn Then
Call comb(ans(), , , myx + 1, ctx + 1)
End If
myx = myx + 1
idx = idx + 1
cnt = cnt + 1
Loop
idx = idx - 1
End Function
|
|
ichinose
- 03/5/14(水) 18:39 -
