[[20100601145555]]　『パズルのような…』（BIKKLE）　ページの最後に飛ぶ

『パズルのような…』（BIKKLE）

下記のような買った物リストがあったとします。
Ａ列に品物、Ｂ列に金額です。

　　Ａ　　　　　　　　Ｂ

　みかん　　　　　　105

　レモン　　　　　　312

　いちご　　　　　　896

　すいか　　　　　　1153

　ぶどう　　　　　　550

しかしこの中に実際に買っていない商品が紛れ込んでしまったようなのです。
わかっているのは実際に支出した総合金額だけです。
例えば総支出は2015円のはずなのに、このデータ上では3016円になっている。
3016円-2015円＝1001円。
どの組み合わせを除けば実際に支出した商品のみのリストになるか？を知りたいです。
このパターンならみかんといちごが紛れてしまった商品と言えます。

しかし実際のデータは約50以上の項目の中から800万円程の紛れ込みを抽出しなければ
なりません。
何個が紛れてしまっているかもわかりません。
除かなければならない金額の組み合わせを抜粋出来れば嬉しいです。
どなたかお分かりになりますか？

2003　ＸＰです。

[[20030603105132]]　『合計数からどの数字を足したかを知りたい』（のんのん）

 ご参考（ぞう）

 新規ブックにて試してみてください。

 標準モジュール（Module1）に組合せリスト作成プロシジャー群（インデックス編）。

 '=========================================================================
 Option Explicit
    Private c_svsn As Long '抜き取り数保存
    Private c_svsmpn As Long '標本数保存
    Private c_idx() As Long '配列のカレントポインタ
    Private cs_x() As Long '配列の基盤ポインタ
    Private c_eof As Boolean
 '=========================================================================
 Function init_comb(smpnum As Long, seln As Long) As Double
    '組合せ処理ルーチンの初期化
    'Input　： smpnum  標本数　seln 抜き取り数
    'output : init_comb 組合せ数
    Dim g0 As Long
    c_svsn = seln
    c_svsmpn = smpnum
    Erase c_idx()
    Erase cs_x()
    g0 = 1
    ReDim cs_x(1 To seln)
    ReDim c_idx(1 To seln)
    For g0 = 1 To UBound(c_idx())
      cs_x(g0) = g0
      c_idx(g0) = g0
    Next
    c_idx(UBound(c_idx())) = c_idx(UBound(c_idx())) - 1
    init_comb = WorksheetFunction.Combin(smpnum, seln)
    c_eof = False
 End Function
 '=========================================================================
 Function get_comb(ans()) As Long
    '組合せリストのインデックスを配列として返す
    'input : なし
    'output: ans() 組合せリストのインデックスを格納する
    '        get_comb  0:正常に取得　　1　リストの終わり
    Dim g0 As Long
    Dim g1 As Long
    get_comb = 1
    If c_eof Then Exit Function
    For g0 = UBound(c_idx()) To LBound(c_idx()) Step -1
       If c_idx(g0) + 1 <= c_svsmpn - c_svsn + g0 Then
          c_idx(g0) = c_idx(g0) + 1
          get_comb = 0
          Exit For
       Else
          c_idx(g0) = cs_x(g0) + 1
          cs_x(g0) = cs_x(g0) + 1
          For g1 = g0 + 1 To UBound(cs_x())
             cs_x(g1) = cs_x(g1 - 1) + 1
             c_idx(g1) = cs_x(g1)
          Next g1
       End If
    Next
    If get_comb = 0 Then
       For g0 = LBound(c_idx()) To UBound(c_idx())
          ans(g0) = c_idx(g0)
       Next
    Else
       c_eof = True
    End If
 End Function
 '=========================================================================
 Sub close_comb()
    '組合せ処理ルーチンの終了処理
    Erase c_idx()
    Erase cs_x()
 End Sub
 '=========================================================================
 Function skip_comb(i_num As Long, ans() As Variant) As Long
    '指定したインデックスを一つ増加させる
    'input: i_num:増加させるインデックス
    'output: ans()組合せリストのインデックスを格納する
    '        skip_comb   0:正常に取得　　1　リストの終わり
    Dim g0 As Long
    Dim g1 As Long
    skip_comb = 1
    If c_eof Then Exit Function
    For g0 = i_num To LBound(c_idx()) Step -1
       If c_idx(g0) + 1 <= c_svsmpn - c_svsn + g0 Then
          skip_comb = 0
       End If
       c_idx(g0) = c_idx(g0) + 1
       cs_x(g0) = c_idx(g0)
       For g1 = g0 + 1 To UBound(cs_x())
          cs_x(g1) = cs_x(g1 - 1) + 1
          c_idx(g1) = cs_x(g1)
       Next g1
       If skip_comb = 0 Then Exit For
    Next
    If skip_comb = 0 Then
       For g0 = LBound(c_idx()) To UBound(c_idx())
          ans(g0) = c_idx(g0)
       Next
    Else
       c_eof = True
    End If
 End Function

 別の標準モジュール（Module2）に

 '=========================================================================
 Sub samp()
    Dim 希望総支出 As Long
    Dim 総支出 As Long
    Dim rng As Range
    Dim snum As Long
    Dim nuki As Long
    Dim 解 As Long
    Dim g0 As Long
    Dim ret As Long
    Dim asum As Long
    Dim g1 As Long
    Dim g2 As Long
    Dim g3 As Long
    Dim skipidx As Long
    Set rng = Range("a1", Cells(Rows.Count, "a").End(xlUp)).Resize(, 2)
    rng.Sort key1:=Range("b1"), header:=xlNo
    総支出 = Application.Sum(rng.Columns(2))
    Set rng = rng.Columns(2)
    希望総支出 = 2015    
    解 = 総支出 - 希望総支出
    snum = rng.Rows.Count
    g2 = 1
    For g0 = 1 To snum
       Call init_comb(snum, g0)
       ReDim ans(1 To g0)
       ret = get_comb(ans())
       Do While ret = 0
          asum = 0
          For g1 = LBound(ans()) To UBound(ans())
             asum = asum + rng.Cells(ans(g1)).Value
          Next
          If asum > 解 Then
             skipidx = get_skipidx(ans())
             If skipidx = 0 Then
                ret = 99
             Else
                ret = skip_comb(skipidx, ans())
             End If
          Else
             If asum = 解 Then
                g3 = 6
                For g1 = LBound(ans()) To UBound(ans())
                   Cells(g2, g3).Value = rng.Cells(ans(g1)).Offset(0, -1).Value
                   Cells(g2, g3 + 1).Value = rng.Cells(ans(g1)).Value
                   g3 = g3 + 2
                Next
                g2 = g2 + 1
             End If
             ret = get_comb(ans())
          End If
       Loop
       Call close_comb

    Next
    Set rng = Nothing
    erase ans() 
End Sub
 '==========================================================================
 Function get_skipidx(ans()) As Long
    Dim g0 As Long
    Dim repnum As Long
    get_skipidx = 0
    repnum = ans(UBound(ans()))
    For g0 = UBound(ans()) - 1 To LBound(ans()) Step -1
       repnum = repnum - 1
       If ans(g0) <> repnum Then
          get_skipidx = g0
          Exit For
       End If
    Next
 End Function

 例1

   　Ａ　　　　　　　　Ｂ 
 １　みかん　　　　　　105 
 ２　レモン　　　　　　312 
 ３　いちご　　　　　　896 
 ４　すいか　　　　　　1153 
 ５　ぶどう　　　　　　550

 上記データがあるシートをアクティブにして上記　samp　実行してみてください。

 同シートのセルF1から、

 みかん	105	いちご	896

 という結果を表示します。

 又、
 例２

   　  Ａ　　　　　Ｂ
 　１　a　　　　　105
 　２　b　　　　　312
 　３　c　　　　　550
 　４　d　　　　　896
 　５　e　　　　　1153
 　６　f　　　　　1001
 　７　g　　　　　9257
 　８　h　　　　　5508
 　９　i　　　　　8291
 １０　j　　　　　8576
 １１　k　　　　　3367
 １２　l　　　　　2636
 １３　m　　　　　1762
 １４　n　　　　　8711
 １５　o　　　　　1691
 １６　p　　　　　7216
 １７　q　　　　　871
 １８　r　　　　　970
 １９　s　　　　　8302
 ２０　t　　　　　4492
 ２１　u　　　　　7329
 ２２　v　　　　　　38
 ２３　w　　　　　7137
 ２４　x　　　　　451
 ２５　y　　　　　8449
 ２６　z　　　　　3031

 こんなデータがあるシートをアクティブにして、
 samp内の

 希望総支出 = 2015

を

 希望総支出 = 90500　　’＊＊＊＊＊＊＊＊

 に変更して実行すると、

 セルＦ１から、１７通りの組合せを表示します。

 試してみてください。

 因みに私の環境で　例２で処理時間は、１７秒程度でした。

 ichinose@ちょっと訂正（ひとつプロシジャーの記述忘れ）

 更にコメント訂正

 [[20100602143343]]

コメント返信：

[ 一覧(最新更新順) ]

[[20100601145555]] 『パズルのような…』（BIKKLE） ページの最後に飛ぶ

[[20100601145555]]　『パズルのような…』（BIKKLE）　ページの最後に飛ぶ