Excel VBA質問箱 IV

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

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


65900 / 76738 ←次へ | 前へ→

【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では、この辺のチェックも必要ですね!!

0 hits

【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 お礼

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