Results of 1 - 1 of about 37684 for IF (0.007 sec.)
- [[20061002220044]]
- #score: 1591
- @digest: 719b6e541d9ffa317b4f5dc9dcda5be9
- @id: 25555
- @mdate: 2006-10-04T12:10:51Z
- @size: 10901
- @type: text/plain
- #keywords: myans2 (48690), mattaku (44989), datacnt (39735), myarray2 (25703), kumiawase (22494), myans3 (14996), 内一 (14963), myans (10548), data3 (10036), data2 (10016), 給油 (9910), レシ (9586), data4 (9490), vbnarrow (8991), myarray (7672), ガソ (6580), strconv (6513), 回分 (6420), combin (6400), data1 (5897), 番近 (5411), tbl (3864), トル (3814), ソリ (3687), double (3634), tbl2 (3123), maxrow (3029), tbl1 (2839), 150 (2619), address (2320), columns (2211), val (2161)
- 『複数の数字の合計』（MATT）
はじめまして。早速ですが以下の内容よろしくお願いします。 近所のガソリンスタンドでこのような特典があります。 「ガソリン150リットル分のレシートで500円の商品券プレゼント」 そこで質問ですが、たまりにたまったレシートの給油量を入力し、150リットル以上で なおかつ、150リットルに限りなく近くなるレシートの組み合わせを計算式または関数 で簡単に出来ないでしょうか? 例えば、A**リットル、B**リットル、C**リットル、D**リットル、E**リットル、F**リットルの場合、 A+C=151リットル、B+D=151.5リットルみたいな計算を簡単にしたいのです。 うまく説明できませんが、よろしくお願いします。 EXCEL2002 WIN XPです。 ---- こんな関数はどうでっか? Alt+F11でVBEを開く 「挿入」→「標準モジュール」を選択 真新しいモジュールに下のコードをコピペ エクセルに戻り A B C D E 1 85リットル 98リットル 69.5リットル 92リットル 70リットル 2 3 と、まあ、こんな具合にデータを配置し、F1あたりに=matt(a1:e1)と入力してみて おくんなはれ。 どうでっか、こんな塩梅で? （弥太郎） Function matt(adrs As Range) Dim x As Double, i As Integer, n As Integer Dim data As Double, s_data As Double, tbl As Range, y(2) Set tbl = adrs x = 500 For i = 1 To tbl.Columns.Count data = Val(StrConv(tbl(1, i), vbNarrow)) For n = i + 1 To tbl.Columns.Count s_data = Val(StrConv(tbl(1, n), vbNarrow)) If data + s_data >= 150 Then If data + s_data - 150 < x Then x = data + s_data - 150 y(0) = tbl(1, i).Address(0, 0) y(1) = tbl(1, n).Address(0, 0) End If End If Next n Next i matt = x + 150 & "," & y(0) & "と" & y(1) End Function ---- 2回給油分の組み合わせですか??? 3回分4回分等の組み合わせも有るのでしょうか??? (JJ) ---- A B 3回分4回分等の組み合わせも有るのでしょうか? 1 1 70 2 2 75 3 3 83 4 4 90 5 5 76 6 6 88 7 7 84 8 8 92 9 9 68 10 10 70 11 11 77 12 12 56 13 13 68 14 14 91 15 15 87 16 17 15回給油したとして 18 =COMBIN(15,2)=105の内一番近い数字を選ぶ（2回のみの組み合わせ） 19 =COMBIN(15,3)=455の内一番近い数字を選ぶ（3回のみの組み合わせ） 20 =COMBIN(15,4)=1365の内一番近い数字を選ぶ（4回のみの組み合わせ） の内一番近い数字を選ぶになりますが jj ---- 質問内容からすると n枚のレシートからm（1≦m≦n）枚取り出してその合計が150以上で 最小値になる組み合わせを求めるということでしょうか。 実際は、求めた組み合わせのデータを除いた中から同じように 抽出を繰り返すのでしょう。 （やっちん） ---- な〜るほろ〜。 いかにもありそうでんなぁ。 ほならこないな事でっしゃろか? =mattaku(a1:j1,3) っちゅう塩梅に入力。抽出されたセルのデータを消去していく。 組合せ4までですけど、それ以上あるばやいはコードの規則性に従って書き加えてく らはい。 =mattaku(a1:j1)と引数を省略したら2回の組合せで抽出します。 （弥太郎） Function mattaku(adrs As Range, Optional mai = 2) Dim x As Double, i As Integer, n As Integer, t As Integer, j As Integer Dim data1 As Double, data2 As Double, data3 As Double, data4 As Double, tbl As Range, y(3) Set tbl = adrs x = 1000 With tbl Select Case mai Case 4 For i = 1 To .Columns.Count - 3 If tbl(1, i) <> "" Then data1 = Val(StrConv(tbl(1, i), vbNarrow)) For n = i + 1 To .Columns.Count - 2 If tbl(1, n) <> "" Then data2 = data1 + Val(StrConv(tbl(1, n), vbNarrow)) For j = n + 1 To tbl.Columns.Count - 1 If tbl(1, j) <> "" Then data3 = data2 + Val(StrConv(tbl(1, j), vbNarrow)) For t = j + 1 To tbl.Columns.Count If tbl(1, t) <> "" Then data4 = data3 + Val(StrConv(tbl(1, t), vbNarrow)) If data4 >= 150 Then If data4 - 150 < x Then x = data4 - 150 y(0) = tbl(1, i).Address(0, 0) y(1) = tbl(1, n).Address(0, 0) y(2) = tbl(1, j).Address(0, 0) y(3) = tbl(1, t).Address(0, 0) End If End If End If Next t End If Next j End If Next n End If Next i mattaku = x + 150 & "は" & Join(y, ",") Exit Function Case 3 For i = 1 To .Columns.Count - 2 If tbl(1, i) <> "" Then data1 = Val(StrConv(tbl(1, i), vbNarrow)) For n = i + 1 To .Columns.Count - 1 If tbl(1, n) <> "" Then data2 = data1 + Val(StrConv(tbl(1, n), vbNarrow)) For j = n + 1 To .Columns.Count If tbl(1, j) <> "" Then data3 = data2 + Val(StrConv(tbl(1, j), vbNarrow)) If data3 >= 150 Then If data3 - 150 < x Then x = data3 - 150 y(0) = tbl(1, i).Address(0, 0) y(1) = tbl(1, n).Address(0, 0) y(2) = tbl(1, j).Address(0, 0) End If End If End If Next j End If Next n End If Next i mattaku = x + 150 & "," & y(0) & "と" & y(1) & "と" & y(2) Exit Function Case 2 For i = 1 To .Columns.Count - 1 If tbl(1, i) <> "" Then data1 = Val(StrConv(tbl(1, i), vbNarrow)) For n = i + 1 To .Columns.Count If tbl(1, n) <> "" Then data2 = data1 + Val(StrConv(tbl(1, n), vbNarrow)) If data2 >= 150 Then If data2 - 150 < x Then x = data2 - 150 y(0) = tbl(1, i).Address(0, 0) y(1) = tbl(1, n).Address(0, 0) End If End If End If Next n End If Next i End Select If y(0) = "" Then Exit Function mattaku = x + 150 & "," & y(0) & "と" & y(1) End With End Function ---- A1:A15 の範囲に（上から順に間を明かさず｝リットル数を書き込んで、 下記のマクロを実行してみて下さい。 （純丸）(o^-')b もっと配列の扱いがすっきり出来るんだろうなぁw Sub test2() Dim tbl1, tbl2 Dim i As Long Dim ii As Integer Dim datacnt As Long Dim myans As Single Dim myans2 As Single Dim myans3 As Long datacnt = Application.WorksheetFunction.Count(Range("A1:A15")) Range("A1:A15").Font.ColorIndex = 0 ReDim tbl1(1 To datacnt) ReDim tbl2(1 To datacnt) myans = 150 For i = 1 To datacnt tbl1(i) = Cells(i, 1).Value Next i For i = 1 To 2 ^ datacnt For ii = 1 To datacnt tbl2(ii) = Int(i / (2 ^ (ii - 1))) Mod 2 myans2 = myans2 + tbl1(ii) * tbl2(ii) Next ii myans2 = myans2 - 150 If myans2 < 0 Then GoTo mynext If myans > myans2 Then myans = myans2 myans3 = i End If mynext: myans2 = 0 Next i For ii = 1 To datacnt If Int(myans3 / (2 ^ (ii - 1))) Mod 2 = 1 Then Cells(ii, 1).Font.ColorIndex = 3 End If Next ii Range("A17").Value = Application.WorksheetFunction.RoundDown(myans, 1) + 150 End Sub ---- 本当に正しいのか怪しいのですが(^^; 無駄な動きをしている部分もありますが、とりあえず。 A列に連番、B列に数値だけのデータを入力。C列は必ずクリアしておいてください。 A列とB列をB列昇順に並び替えます。 ここでTestを実行してください。 D列に合計、E列に組み合わせの番号が出ます。 Dim Min_Pt As String Dim Min_Sm As Double Dim MyArray As Variant Dim MaxRow As Long Const LMT150 = 150# Sub Test() Dim Cnt As Long Dim MyArray2 As Variant Dim j As Long Cnt = 0 MyArray = Range(Range("A1"), Range("B" & Rows.Count).End(xlUp).Offset(, 1)) MaxRow = UBound(MyArray, 1) Do Cnt = Cnt + 1 Min_Sm = 9999999999999# Min_Pt = "" Call Kumiawase(0, 0, "", False) If Min_Pt <> "" Then Cells(Cnt, 4).Value = Min_Sm Cells(Cnt, 5).Value = Mid(Min_Pt, 2) MyArray2 = Split(Mid(Min_Pt, 2), ",") For j = 0 To UBound(MyArray2, 1) MyArray(Application.Match(Val(MyArray2(j)), Columns(1), 0), 3) = 1 Next End If Loop Until Min_Pt = "" End Sub Sub Kumiawase(ByVal i As Long, ByVal Sm As Double, ByVal Pt As String, ByRef Flg As Boolean) Dim wk As Long If Sm >= LMT150 Then If Min_Sm > Sm Then Min_Pt = Pt Min_Sm = Sm End If Flg = True Exit Sub End If Do While i < MaxRow wk = ix(i + 1) If wk <= MaxRow Then Call Kumiawase(wk, Sm + MyArray(wk, 2), Pt & "," & MyArray(wk, 1), Flg) If Flg = True Then Flg = False Exit Sub End If End If i = ix(i + 1) Loop End Sub Function ix(ByVal i As Long) As Long ix = i Do While ix <= MaxRow If MyArray(ix, 3) <> 1 Then Exit Function End If ix = ix + 1 Loop End Function （やっちん） ---- みなさん。ご回答有難うございました。まだまだ初心者の私にもなんとか出来ました。 とりあえず、やっちんさんのを使わせていただきます。 （MATT)... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/200610/20061002220044.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97043 documents and 608214 words.
訪問者：