[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『パズルのような…』(BIKKLE)
下記のような買った物リストがあったとします。
A列に品物、B列に金額です。
A B
みかん 105
レモン 312
いちご 896
すいか 1153
ぶどう 550
しかしこの中に実際に買っていない商品が紛れ込んでしまったようなのです。
わかっているのは実際に支出した総合金額だけです。
例えば総支出は2015円のはずなのに、このデータ上では3016円になっている。
3016円-2015円=1001円。
どの組み合わせを除けば実際に支出した商品のみのリストになるか?を知りたいです。
このパターンならみかんといちごが紛れてしまった商品と言えます。
しかし実際のデータは約50以上の項目の中から800万円程の紛れ込みを抽出しなければ
なりません。
何個が紛れてしまっているかもわかりません。
除かなければならない金額の組み合わせを抜粋出来れば嬉しいです。
どなたかお分かりになりますか?
2003 XPです。
ご参考(ぞう)
新規ブックにて試してみてください。
標準モジュール(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
A B 1 みかん 105 2 レモン 312 3 いちご 896 4 すいか 1153 5 ぶどう 550
上記データがあるシートをアクティブにして上記 samp 実行してみてください。
同シートのセルF1から、
みかん 105 いちご 896
という結果を表示します。
又、 例2
A B 1 a 105 2 b 312 3 c 550 4 d 896 5 e 1153 6 f 1001 7 g 9257 8 h 5508 9 i 8291 10 j 8576 11 k 3367 12 l 2636 13 m 1762 14 n 8711 15 o 1691 16 p 7216 17 q 871 18 r 970 19 s 8302 20 t 4492 21 u 7329 22 v 38 23 w 7137 24 x 451 25 y 8449 26 z 3031
こんなデータがあるシートをアクティブにして、 samp内の
希望総支出 = 2015
を
希望総支出 = 90500 ’********
に変更して実行すると、
セルF1から、17通りの組合せを表示します。
試してみてください。
因みに私の環境で 例2で処理時間は、17秒程度でした。
ichinose@ちょっと訂正(ひとつプロシジャーの記述忘れ)
更にコメント訂正
[[20100602143343]]
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.