『合計数からどの数字を足したかを知りたい』（のんのん） 初めまして。ここで何度も勉強させて頂いてます。 今回の質問は、一覧表にいくつも数字が入っています。 別で合計数もわかってます。 その合計数の欄に合計を打ち込むこニで一覧表の中のどの数字を足したのが知りたいのです。 できれば、マクロを使用したくないのですが、関数だけでは無理だろうと思ってます。 マクロに関しては、ほとんどわかっていないです。 宜しくお願い致します。 ---- 例えば下のようなデータ表があって、 10 20 40 合計 70 20 40 70 合計 130 40 50 90 合計 180 130と入力したら20と40と70です、 180と入力したら40と50と90です と答えればよいのでしょうか？これならVLOOKUPで可能です。 （kazu） ----- お返事ありがとうございます♪ VLOOKUPナ可能ですか？ どのような式になるのでしょうか教えてください。 この式でできるかどうかやってみないとわかりませんか、 具体的に数字を書きます。 1,585,500 　　 98,700 　1,757,312　 1,522,500　　　　　　↑の数字が左の９個の数字のうち幾つか選んで 1,313　　　　　　足された数字です。 18,291　　　　　　　どの数字を選んだのか　を知りたいのです。　 2,499 21,263　　　　　　 69,753 231,000 お忙しいとは思いますが、宜しくお願い致します。 ---- 大きいほうから引いていってみましたが、合計数にマッチしません もしかして、 [９個の数字のうち幾つか選んで複数回足された数字] なのでしょうか？ （kazu） 1757321 1757321 1585500 171821 1522500 234821 231000 98700 73121 136121 69753 3368 66368 21263 45105 18291 26814 2499 869 24315 1313 23002 X X ---- お手数おかけしてます。 今回の答えは、 1,522,500＋1,313＋2,499＋231,000＝1,757,312 です。 同カ数字を何回も足す事はありません。 宜しくお願い致します。 (のんのん) ---- 納得しました。私のポカポカミスです。 ここで質問です マクロはともかく、ユーザー関数ですが、 ↓[エクセルの学校（e1iw）ユーザー関数入門]を見て理解して、使えますか？ http://www.excel.studio-kazu.jp/lib/e1iw/e1iw.html （kazu） 1757312 1757312 1585500 171812 1522500 234812 231000 3812 98700 73112 69753 3359 21263 18291 2499 860 1313 1313 0 × ○ ---- お返事ありがとうございます！ ユーザー関数入門通りA消費税の件を作ってみました。 自分で関数式を作るということですね。 わかりやすく書いてくれてましたので、無事にできました！ これなら大丈夫です。 そして、上記のkazuさんの、どういう原理で答えが出るかもわかります。 合計数から最大値（又は最大値に近い値）を引き、その残数の中での最大値を引いていく。 こういう考え方があったんだ！と驚いてます。 ただ、関数式をどのようにして、どこにどのような式を入れたらいいのか…。 ご指導の続きをお願い致します。 ---- 文字化けを直してもらった謔、ですね。スミマセン。 少しトライしてみましたが、予備テストと同じ最初のデータで計算してしまうため [分割できませんでした。1585500, 98700, 69753, 2499, 残り 860] になります。 ワークシート側で1585500をクアIgやると、正しく分割できます。 考え方を変えて総当り方式ナやらないとだめゥ烽オれません。 Dim の位置に注意して、やってみてください。 （kazu） [ワークシート側] 　セルA3からA11に数値のデータを大きい順に入力します。 　セルB3に 　=ufnumbersep(D1,A3:A11) [VBA側] Dim numtable(20) As Long, tcnt As Integer Function UFNumberSep(sum, addr As Range) Dim i As Integer, j As Integer, adr As Range ' テ[ブルに数値をセット（大きいものから並んでいると仮定） For Each adr In addr numtable(i) = adr.Value i = i + 1 Next tcnt = i - 1 ' テーブルの中身を上から順に引き算する For j = 0 To tcnt If numtable(j) <= sum Then sum = sum - numtable(j) UFNumberSep = UFNumberSep & numtable(j) & ", " End If Next If sum <> 0 Then UFNumberSep = "分割できませんでした。" & UFNumberSep & " 残り " & sum End If End Function ---- ありがとうございます！！ すごい！　感動しましス。　できるもんなんやぁ。 B3に見本通りの式を入れ、D1 を $D$1 にして、 B3の式を下にドラックしていくと、１ヶ所だけ、『分割できませんでした』の文字がないんですもん。すぐにわかりますね。 Dim numtable(20)　の20というのは、20行の事でしょうか？ もう少し数字を増やしてやってみよう♪と思ってやってみたのですが… 1,585,500 1,522,500 231,000　　@　答えは1522500,69753,16400,3939＝1612592 98,700 69,753　　　　ですが、この式でいくと、 65,000 39,056　　　　1522500の欄の回答は 21,263　　　　分割できませんでした。1522500,69753,18291,1313,0,残り735 20,500 18,291　　　　になりました。 16,400 4,000　　　　必ずしも残数内の最大値が答えにならないのですね。 3,939 2,499 1,313 今後、５０行ぐらいになる可能性もあります。 どうしたらよろしいのでしょうか。。。　宜しくお願い致しますB ---- Dim numtable(20)　の20というのは、20個配列を確保するということです。 数値が増えてきたら大きくする必要があります。 今のやり方では分割できないケースが多いので、総当りで解く方法を考え中です。 少し待ってくださいB （kazu） ---- 総当りで計算するタイプです。まだバグがあるかもしれませんが、 一応動くと思いますので、で試してみてください。 VBAの行数が多くなってきたので、 下のコードをコピーしてVBAで貼り付けてください。 （kazu） [ワークシート側] =ufnumbersep2(D1,A3:A11) [VBA側] Dim numtable(50) As Long, tcnt As Long Function UFDecToBin(dec As Long, keta As Long) Dim wk As Variant, ans As Long, amari As Long, zero As String Dim m As Long ans = 0 wk = "" While dec > 0 ans = Int(dec / 2) amari = dec Mod 2 wk = amari & wk dec = ans Wend wk = ans & wk For m = 0 To 49 zero = zero & "0" Next m UFDecToBin = Right(zero & wk, keta) Exit Function End Function Function UFNumberSep2(sum As Long, addr As Range) Dim i As Long, j As Long, adr As Range, tcnt As Long, b As Variant Dim wj As Long, sumwk As Long, k As Long, addwk As Variant On Error GoTo er01 sumwk = 888 For Each adr In addr numtable(i) = adr.Value i = i + 1 Next tcnt = i - 1 For j = 0 To (2 ^ (tcnt + 1)) - 1 wj = j b = UFDecToBin(wj, tcnt + 1) sumwk = 0 addwk = "" For k = 0 To tcnt + 1 If Mid(b, k + 1, 1) = "1" Then sumwk = sumwk + numtable(k) addwk = addwk + ", " & numtable(k) If sumwk = sum Then UFNumberSep2 = "OK " & addwk Exit Function End If End If Next k Next j UFNumberSep2 = "NG " Exit Function er01: If Err = 6 Then UFNumberSep2 = "OVF" Else UFNumberSep2 = "Err " & Err End If End Function ----- お手数おかけしてます。 朝早くからのお返事ありがとうございます。 早速やってみましたが、A17までの入力なら、可能でした。 しかし、A18に数字をいれると、#VALUE!が出てしまいます。 15個までしかだめなんです。 難しい質問で申し訳ないです。 宜しくお願い致します。 　　　（のんのん） ---- スミマセン、やはりバグがありましたね。 上フVBAコードを変更しましたので、コピーしなおしてください。 それから、計算している時間の長さは気になりませんか？ （kazu） ---- こんにちは。 行おうと思い、コピーして処理しましたら、 『名前が適切ではありません: UFNumberSep2x と出てきワした。 どうしたらよろしいのでしょう…？ （のんのん） ---- 以前のUFNumberSep2が残っているので、名前がダブったのだと思います。 最初のころ作った Function UFNumberSep から End Function まナ削除して、 再度コピーペーストしてトライしてみてください。 （kazu） ---- ありがとうございます。 削除が上手くいかないので、Moduleを削除して新しく作りました。 今は、A3〜A24まで数字を入れています。 そして、繼Lの式をコピーして処理しまして、ワークシートの式の中の範囲も変更しましたが、やはり、#VALUE!が出てしまいます。 処理時間はこの量で３５秒かかっていますね。 恐れ入りますが、またご指導願います。 （のんのん） ---- 途中でおかしくならないように対策しました。 上のVBAをコピーしてテストしてください。 21 件までeストしましたが私のATHRON800ですでに4分半かかります、 2の21乗は2097152の組み合わせを総当りしていることになります。 あとは鋭意テストしてみてください。 （kazu） ---- お返事有難うごエいます。 早速行いましたが、マクロをコピー貼り付けして、エクセルに戻り、 式の入っているセルでEnterを押すと、PCが固まってしまいます…。 プログラムの強制終了欄を見てみると、【応答なし】になってしまいます。 実行ナきないのがくやしいー！ この件で何かわかる事があれば教えてください。 （のんのん） ----　 まづ、[ツール(T)]メニューの[オプション(O)]で[計算方法]を[手動]にしてください。 はじめはデータ数1 件とか2 件からやってみてください。 OSは何ですかWindows？、CPUは何ですか？、メモリーは何MB？ （kazu） ---- 私のノートPCは、Windows98、CPUはPentiumV、メモリーは127MBです。 で、手動にしました。 データ数とはどこの欄の事でしょうか？ （のんのん） ---- ノートPCですか、Windows98だと少し厳しいかもしれません。 データ数はここの部分↓のことです。 　=ufnumbersep2(D1,A3:A4) （kazu） ---- デスクトップの、WindowsMe、CPUはCeleron、メモリーは127MBのPCでやってみました。 手動にて、範囲を変えて計算してみました。 数値が17個までの範囲なら、可能です。31秒です。 しかし、18個になると、【応答なし】になります。 これが限度でしょうか？ （のんのん） ---- Pentium III 996MHz DELL機 Windows98 メモリー256MBでテストしました。 19 件で 1 分 20 件で 2 分 21 件で 4 分 22 件で 8 分 23 件で 17 分 24 件で 35 分 25 件で 75 分 ハングはしませんが、このへんが人間にとって限度でしょうか。 （kazu） ---- お返事が遅くなって申し訳ないです。 やはり、この辺が限度ですか。 でも、本当に助かりました! ありがとうございました！ (のんのん)