Excel VBA質問箱 IV

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

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


11566 / 13645 ツリー ←次へ | 前へ→

【15381】残りのない組み合わせ さき 04/6/22(火) 22:45 質問[未読]
【15382】Re:残りのない組み合わせ ちゃっぴ 04/6/22(火) 23:12 発言[未読]
【15383】Re:残りのない組み合わせ ichinose 04/6/23(水) 0:04 発言[未読]
【15385】Re:残りのない組み合わせ くんくん 04/6/23(水) 7:56 質問[未読]
【15387】Re:残りのない組み合わせ くんくん 04/6/23(水) 8:47 質問[未読]
【15390】Re:残りのない組み合わせ ちゃっぴ 04/6/23(水) 10:56 発言[未読]
【15392】Re:残りのない組み合わせ くんくん 04/6/23(水) 11:41 質問[未読]
【15403】Re:残りのない組み合わせ ちゃっぴ 04/6/23(水) 16:41 発言[未読]
【15405】Re:残りのない組み合わせ ichinose 04/6/23(水) 19:21 回答[未読]
【15406】Re:残りのない組み合わせ 訂正と追伸 ichinose 04/6/23(水) 19:35 発言[未読]
【15410】ありがとうございます。 くんくん 04/6/24(木) 9:12 お礼[未読]

【15381】残りのない組み合わせ
質問  さき  - 04/6/22(火) 22:45 -

引用なし
パスワード
   一番残りのない組み合わせの一覧を表示させたいのですが、
数学とか(統計とか?)関係あるんでしょうか?
例えば、「大幅500」があったとします。
その大幅に組み合わせる小幅として
300X1
200X1
100X3
150X1
があったとします。
これらの小幅の組み合わせで、一番残幅の少ないものから順に
表示させたいのですが、考え方がわかりません。
小幅の組み合わせで一番残りの少ない組み合わせは
300X1 200X1 (残幅0)
100X3 150X1 (残幅50)
と計算したいのですが、VBAのコード以前に考え方が
分からなくて行き詰まっています。
どなたか、どうか教えてください。

【15382】Re:残りのない組み合わせ
発言  ちゃっぴ  - 04/6/22(火) 23:12 -

引用なし
パスワード
   すみません。小幅がよく理解できないのですが・・・

小幅は与えられているのですか?それとも可変(50づつとか?)?

残幅の定義が
500 - (300 * 1 + 200 * 1) = 0
で与えられるとすれば、この残幅をキーにソートすればいいだけだと
思いますが?

【15383】Re:残りのない組み合わせ
発言  ichinose  - 04/6/23(水) 0:04 -

引用なし
パスワード
   ▼さき さん:
こんばんは。

>一番残りのない組み合わせの一覧を表示させたいのですが、
>数学とか(統計とか?)関係あるんでしょうか?
>例えば、「大幅500」があったとします。
>その大幅に組み合わせる小幅として
>300X1
>200X1
>100X3
>150X1
>があったとします。
>これらの小幅の組み合わせで、一番残幅の少ないものから順に
>表示させたいのですが、考え方がわかりません。
>小幅の組み合わせで一番残りの少ない組み合わせは
>300X1 200X1 (残幅0)
>100X3 150X1 (残幅50)
>と計算したいのですが、VBAのコード以前に考え方が
>分からなくて行き詰まっています。
>どなたか、どうか教えてください。
まず、上記のご質問に対する質問です。

1.上記の組み合わせを行う入力データに当たる
  100x3、150x1・・・というデータ、
 この「100x3」がひとつのデータということですか?
 それとも100の小幅3つという結果も計算によって導き出したいのですか?

2.例題には、ありませんでしたが、50x1という小幅があった場合、

 100x3 150x1 50x1 残0

 これも導き出したい結果のひとつですか?
 つまり、組み合わせが二組とは限らないと言うこともありえますか?

【15385】Re:残りのない組み合わせ
質問  くんくん  - 04/6/23(水) 7:56 -

引用なし
パスワード
   すいません、説明不足でした。
小幅というのは、たくさんありまして、
250や450とか、本当にたくさん、ランダムに
あるんです。
例えば、、、
250
250
450
210
120
120
310
215
150
150
とかいうように5刻みで、です。
VBA以前の問題で、「考え方」(ちゃっぴさんのような)
が分からないのです。

【15387】Re:残りのない組み合わせ
質問  くんくん  - 04/6/23(水) 8:47 -

引用なし
パスワード
   説明の付け足しです。
日々、大幅に沢山の小幅を残幅が最小になる組み合わせを
考えています。

小幅は、前にも書いたとおりに、5刻みです。
500という大幅があれば、
小幅は、ランダムにあって、
305
305
125
300
50
430
430
といった具合です。
その与えられた小幅の中のみで、組み合わせを考え、
残幅の少ないものから順に表示させたいです。
データ量は、すごく多いという量ではありません。

結果は、こんな感じにしたいです。
430 50  (残20)
305 125  (残70)
430    (残70)
305    (残195)
300    (残200)
これで、すべての小幅が組み合わされています。

【15390】Re:残りのない組み合わせ
発言  ちゃっぴ  - 04/6/23(水) 10:56 -

引用なし
パスワード
   >小幅は、前にも書いたとおりに、5刻みです。

小幅の個数制限はないのですか?

制限がなければこういうのもOKになりますが・・・
5 * 100  (残0)

また、残幅にも制限がない場合(100未満など)が
ないと、えらい数の組み合わせができてしまうと
思いますが・・・

> 小幅は、ランダムにあって、

ようは、小幅は求めるのではなくて、
初めから与えられているのですね?

【15392】Re:残りのない組み合わせ
質問  くんくん  - 04/6/23(水) 11:41 -

引用なし
パスワード
   ▼ちゃっぴ さん:
>
>小幅の個数制限はないのですか?
>制限がなければこういうのもOKになりますが・・・
>5 * 100  (残0)
>
>また、残幅にも制限がない場合(100未満など)が
>ないと、えらい数の組み合わせができてしまうと
>思いますが・・・

>ようは、小幅は求めるのではなくて、
>初めから与えられているのですね?

ちゃっぴさん!たびたびすいません。前回はお世話になりました。
(VBAコーディングは自分なりに勉強しようと試みているところです)

はい。小幅は、求めるのではなく、初めから与えられています。
個数の制限があるので、一度、組み合わせに使用すれば、
その個数から引いています。
小幅の必要数は、初めから決まっています。

【15403】Re:残りのない組み合わせ
発言  ちゃっぴ  - 04/6/23(水) 16:41 -

引用なし
パスワード
   ▼くんくん さん:
>はい。小幅は、求めるのではなく、初めから与えられています。
>個数の制限があるので、一度、組み合わせに使用すれば、
>その個数から引いています。
>小幅の必要数は、初めから決まっています。

こういうレイアウトになっていると考えてよろしいですか?

   A    B     
1 大幅   小幅 
2 500    450
3      350
4      200     
5      200
6      150
7      105
8       50
9       50

こんな感じでデータが与えられて、
それに対する組み合わせを残幅の少ない順に
表示したいということですか?

【15405】Re:残りのない組み合わせ
回答  ichinose  - 04/6/23(水) 19:21 -

引用なし
パスワード
   くんくん さん、ちゃっぴさん、こんばんは。
>説明の付け足しです。
>日々、大幅に沢山の小幅を残幅が最小になる組み合わせを
>考えています。
>
>小幅は、前にも書いたとおりに、5刻みです。
>500という大幅があれば、
>小幅は、ランダムにあって、
>305
>305
>125
>300
>50
>430
>430
>といった具合です。
>その与えられた小幅の中のみで、組み合わせを考え、
>残幅の少ないものから順に表示させたいです。
>データ量は、すごく多いという量ではありません。
>
>結果は、こんな感じにしたいです。
>430 50  (残20)
>305 125  (残70)
>430    (残70)
>305    (残195)
>300    (残200)
>これで、すべての小幅が組み合わされています。
まず、仕様です。
上の例題に値を固定してコードを書きました。
コードを見ていただければ、変更は可能かと思います。

アクティブシートのセルA1〜A7に小幅メンバーの数値が入力して下さい。
   A
1  305
2  305
3  125
4  300
5  50
6  430
7  430

この数値を入力して(値は変えてもかまいません)下記に記述してあるmainを実行して下さい。

C列 3行目からリストが表示され、F列には、差幅値(残幅)が表示されます。

では、コードです。
標準モジュール(Module1)に、
'====================================================================
Sub main()
  Const 抜き取り = 2
  Dim rng As Range
  Dim 最小差幅リスト
  Dim r_cnt As Long
  Dim dsprow As Long
  Dim nrng As Range
  Dim 組み合わせ数 As Long
  組み合わせ数 = 抜き取り
  dsprow = 3
  Set rng = Range("a1:a7") '小幅メンバセル範囲のセット
  Do While Not rng Is Nothing
   If rng.Count >= 抜き取り Then
    組み合わせ数 = 抜き取り
   Else
    組み合わせ数 = rng.Count
    End If
   If get_min_comb(rng, 最小差幅リスト, 組み合わせ数, 500) = 0 Then
'                              ↑大幅の値を変更するならこの500を変更

    wk = UBound(最小差幅リスト) - LBound(最小差幅リスト)
    Range(Cells(dsprow, 3), Cells(dsprow, 3 + wk)).Value = 最小差幅リスト
    Cells(dsprow, 6).Value = Evaluate("500-(" & Join(最小差幅リスト, "+") & ")")
    dsprow = dsprow + 1
    End If
   Set rng = get_next_rng(rng, 最小差幅リスト)
'        ↑表示したセル以外の範囲を設定
   Loop
End Sub
'======================================================================
Function get_next_rng(rng, dellist) As Range
'指定されたセル範囲から、dellistに該当しないセルをひとつ削除する
  ReDim rrng(1 To (UBound(dellist) - LBound(dellist) + 1)) As Range
  For idx = LBound(dellist) To UBound(dellist)
   Set rrng(idx) = Nothing
   f_flg = 0
   For Each crng In rng
     If f_flg = 0 And crng.Value = dellist(idx) Then
      f_flg = 1
     Else
      If Not rrng(idx) Is Nothing Then
        Set rrng(idx) = Union(rrng(idx), crng)
      Else
        Set rrng(idx) = crng
        End If
      End If
     Next
   Next
  Set get_next_rng = Nothing
  For idx = LBound(rrng()) To UBound(rrng())
   If Not rrng(idx) Is Nothing Then
     If Not get_next_rng Is Nothing Then
      Set get_next_rng = Application.Intersect(get_next_rng, rrng(idx))
     Else
      Set get_next_rng = rrng(idx)
      End If
     End If
   Next idx
End Function
'=========================================================================
Function get_min_comb(rng As Range, myarray As Variant, 最大抜き取り数 As Long, 大幅 As Long) As Long
'指定されたセル範囲の組み合わせから大幅との差幅の小さい組み合わせを取得する
  Dim idx As Long
  Dim comb_list()
  Dim ans()
  Dim 差幅 As Long
  get_max_comb = 1
  差幅 = 大幅
  For idx = 最大抜き取り数 To 1 Step -1
   ReDim comb_list(1 To idx)
   Call comb_init(rng, idx)
   Do While get_comb(comb_list()) = 0
     wk = Evaluate(大幅 & "-(" & Join(comb_list(), "+") & ")")
     If Evaluate(大幅 & "-(" & Join(comb_list(), "+") & ")") >= 0 Then
      If 差幅 > wk Then
        差幅 = wk
        Erase ans()
        ans() = comb_list()
        get_min_comb = 0
        End If
      End If
     Loop
   Next
  If get_min_comb = 0 Then
   myarray = ans()
   End If
End Function


他の標準モジュール(Module2)に
'=======================================================================
  Private c_svn As Long
  Private c_myarray()
  Private c_idx() As Long
  Private cs_x() As Long
'=======================================================================
Function comb_init(rng As Range, seln As Long) As Double
'組み合わせ情報の初期化
  c_svn = seln
  Erase c_myarray
  Erase c_idx
  Erase cs_x()
  i = 1
  For Each crng In rng
   ReDim Preserve c_myarray(1 To i)
   c_myarray(i) = crng.Value
   i = i + 1
   Next
  ReDim cs_x(1 To seln)
  ReDim c_idx(1 To seln)
  For i = 1 To UBound(c_idx())
   cs_x(i) = i
   c_idx(i) = i
   Next
  c_idx(UBound(c_idx())) = c_idx(UBound(c_idx())) - 1
  comb_init = WorksheetFunction.Combin(rng.Count, seln)
End Function
'======================================================================
Function get_comb(ans()) As Long
'組み合わせメンバーの取得
  get_comb = 1
  For i = UBound(c_idx()) To LBound(c_idx()) Step -1
    If c_idx(i) + 1 <= UBound(c_myarray()) - c_svn + i Then
     c_idx(i) = c_idx(i) + 1
     get_comb = 0
     Exit For
    Else
     c_idx(i) = cs_x(i) + 1
     cs_x(i) = cs_x(i) + 1
     For j = i + 1 To UBound(cs_x())
      cs_x(j) = cs_x(j - 1) + 1
      c_idx(j) = cs_x(j)
      Next j
     End If
    Next
  If get_comb = 0 Then
    For i = LBound(c_idx()) To UBound(c_idx())
     ans(i) = c_myarray(c_idx(i))
     Next
    End If
End Function


以上です。
くんくん さんが都合の良いような変更は、mainプロシジャーの入力データの箇所の
変更でよいと思いますが・・・。
確認してみて下さい。

それから、次回からは、こういうアルゴリズムに関するようなご質問は
もう少し詳しく(例えば、例も最低3例ぐらい)記述して下さいね!!

【15406】Re:残りのない組み合わせ 訂正と追伸
発言  ichinose  - 04/6/23(水) 19:35 -

引用なし
パスワード
   ▼ichinose さん:
>>これで、すべての小幅が組み合わされています。
>まず、仕様です。
>上の例題に値を固定してコードを書きました。
>コードを見ていただければ、変更は可能かと思います。
>
>アクティブシートのセルA1〜A7に小幅メンバーの数値が入力して下さい。
>   A
>1  305
>2  305
>3  125
>4  300
>5  50
>6  430
>7  430
>
>この数値を入力して(値は変えてもかまいません)下記に記述してあるmainを実行して下さい。
>
>C列 3行目からリストが表示され、F列には、差幅値(残幅)が表示されます。
>
>では、コードです。
>標準モジュール(Module1)に、
>'====================================================================
> Sub main()
>  Const 抜き取り = 2
>  Dim rng As Range
>  Dim 最小差幅リスト
  Dim r_cnt As Long ' 使ってないので削除
>  Dim dsprow As Long
  Dim nrng As Range '使ってないので削除
>  Dim 組み合わせ数 As Long
>  組み合わせ数 = 抜き取り
>  dsprow = 3
>  Set rng = Range("a1:a7") '小幅メンバセル範囲のセット
>  Do While Not rng Is Nothing
>   If rng.Count >= 抜き取り Then
>    組み合わせ数 = 抜き取り
>   Else
>    組み合わせ数 = rng.Count
>    End If
>   If get_min_comb(rng, 最小差幅リスト, 組み合わせ数, 500) = 0 Then
>'                              ↑大幅の値を変更するならこの500を変更
>
>    wk = UBound(最小差幅リスト) - LBound(最小差幅リスト)
>    Range(Cells(dsprow, 3), Cells(dsprow, 3 + wk)).Value = 最小差幅リスト
>    Cells(dsprow, 6).Value = Evaluate("500-(" & Join(最小差幅リスト, "+") & ")")
>    dsprow = dsprow + 1
>    End If
>   Set rng = get_next_rng(rng, 最小差幅リスト)
>'        ↑表示したセル以外の範囲を設定
>   Loop
> End Sub


留意点

小幅メンバの中に大幅の値を越える値が入っていると
正常に作動しません。(例えば、505とか600)
mainでは、この辺のチェックも必要ですね!!

【15410】ありがとうございます。
お礼  くんくん  - 04/6/24(木) 9:12 -

引用なし
パスワード
   おはようございます。
ちゃっぴさん、私の説明と表現の不足で回答しずらくさせて
しまったようです。ごめんなさい。
ichinoseさん、すごいコードを考えてもらってありがとうございます。
早速、試してみます。
あと、自分の今後のために、コードを参考に勉強したいと思います。

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