[[20210427161428]]　『ある組み合わせの中から更にある条件を満たす組み』（勉強したい）　ページの最後に飛ぶ

『ある組み合わせの中から更にある条件を満たす組み合わせを表示』（勉強したい）

「8種類」の「果物」から「重複」しないように「3種類」づつに分ける場合の「パターン」は「元の数ｎ」と「選ぶ数ｒ」から「8Ｃ３」で「56」パターンです。そこでその「56」パターンのうち「人気の果物1・2・3」が「どれか一つでも入っている組み合わせ」は「何パターン」あるかを「エクセルで表示」したいのですが「何をどうやれば良いのかさっぱりわかりません」エクセルで「表」を作って「数値を入れ替えて」複数のパターンを繰り返し確認してみたいのですが
「VBA」を使わないと「無理」なのでしょうか？説明が下手で分かりにくいかも知れませんがよろしくお願いいたします。※「56」パターンの表示もできません。それが出来れば「検索」などでも出来るかな？とも思ったのですが…べすとは「数値」を入れ替えて「すぐに結果が見える様に」したいです。1日考えましたが「いい方向」へは進みませんでした；

＜使用 Excel：Excel2010、使用 OS：Windows10 ＞

８種類から３種類を選ぶのは56パターンで、
８種類から人気の３種類を除いた５種類から３種類を選ぶのは10パターンなので
人気の３種類が含まれているのは46パターンかと思います。

数式だと、こんな感じ。

 =COMBIN(8,3)-COMBIN(8-3,3)

パターンを表示するなら、VBAがお手軽かと。
ちなみに、全パターン表示の場合は、こんな感じ（1,2,・・8で表示）。

 Sub test()
     r = 1
     For a = 1 To 8
         For b = a + 1 To 8
             For c = b + 1 To 8
                 Cells(r, "A") = a
                 Cells(r, "B") = b
                 Cells(r, "C") = c
                 r = r + 1
             Next
         Next
     Next
 End Sub

（きまぐれ） 2021/04/27(火) 18:41

 こんばんは！
またまた例のnCrをちょっと変更してみました。(最近、こればっかり(^^;)

 Sheet1のA列に↓の様にあって　3　は取り出す個数　その下にデータです。
分かりやすい様に上位3位に数字を付けてみました。

_A_

 3
1すいか
2いちご
3柿
りんご
なし
いかん
もも
すいか

 Sheet2に↓みたいな感じで書き出します。
後は応用していただけると助かります。

 1すいか,2いちご,3柿
1すいか,2いちご,りんご
1すいか,3柿,りんご
2いちご,3柿,りんご
1すいか,2いちご,なし
1すいか,3柿,なし
2いちご,3柿,なし
1すいか,りんご,なし
2いちご,りんご,なし
3柿,りんご,なし
1すいか,2いちご,いかん
1すいか,3柿,いかん
2いちご,3柿,いかん
1すいか,りんご,いかん
2いちご,りんご,いかん
3柿,りんご,いかん
1すいか,なし,いかん
2いちご,なし,いかん
3柿,なし,いかん
1すいか,2いちご,もも
1すいか,3柿,もも
2いちご,3柿,もも
1すいか,りんご,もも
2いちご,りんご,もも
3柿,りんご,もも
1すいか,なし,もも
2いちご,なし,もも
3柿,なし,もも
1すいか,いかん,もも
2いちご,いかん,もも
3柿,いかん,もも
1すいか,2いちご,すいか
1すいか,3柿,すいか
2いちご,3柿,すいか
1すいか,りんご,すいか
2いちご,りんご,すいか
3柿,りんご,すいか
1すいか,なし,すいか
2いちご,なし,すいか
3柿,なし,すいか
1すいか,いかん,すいか
2いちご,いかん,すいか
3柿,いかん,すいか
1すいか,もも,すいか
2いちご,もも,すいか
3柿,もも,すいか

 Option Explicit
Sub てすと()
Dim x As Variant
Dim v As Variant
Dim n As Long
Dim r As Long
Dim k As Long
With Sheets("Sheet1")
    x = .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Value
End With
n = UBound(x, 1) - 1
r = x(1, 1)
ReDim v(1 To Application.Combin(n, r), 1 To 1)
MynCr n, r, "", x, v, k
With Sheets("Sheet2")
    .Cells.Clear
    .Range("A1").Resize(k).Value = v
End With
Erase x, v
End Sub
Function MynCr(ByVal n As Long, ByVal r As Long, ByVal txt As String, ByVal x As Variant, ByRef v As Variant, ByRef k As Long)
Dim y As Variant
Dim q As Variant
Dim i As Long
Dim ix As Long
Dim myflg As Boolean
If r = 0 Then
    y = Split(txt, ",")
    For i = 2 To 4  '上位3の場合
        q = UBound(Filter(y, x(i, 1), True))
        If q > -1 Then myflg = True: Exit For
    Next
    If myflg Then
        k = k + 1
        v(k, 1) = Mid$(txt, 2)
    End If
Else
    For ix = 1 To n
        MynCr ix - 1, r - 1, "," & x(ix + 1, 1) & txt, x, v, k
    Next
End If
End Function
（SoulMan） 2021/04/27(火) 22:41

コメント返信：

[ 一覧(最新更新順) ]

[[20210427161428]] 『ある組み合わせの中から更にある条件を満たす組み』（勉強したい） ページの最後に飛ぶ

[[20210427161428]]　『ある組み合わせの中から更にある条件を満たす組み』（勉強したい）　ページの最後に飛ぶ