[[20020510124352]] 『エクセルの計算式』(momo) >>BOT

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『エクセルの計算式』(momo)

エクセルの計算というかやり方の質問です。数字の組み合わせで合計が0になるようにしたいのです。例えば2330のなかに910、455、255、140、60の5つの数がいくつはいるかということです。2330なら910が2つと255が2つというように、最後にあまりがでないようにしたいのです。どのような方法で、またどのような式をいれればできるのかを教えてください。皆さんお力を!!


 数学が得意そうな人がいるところで聞いたほうがいいかもしれません。

 そういう自分は数学苦手なんですけどね(汗)。

 ↑の例だと2330で910が2つ、255が2つですけど、455x2=910ですよね。

 そうすると910が1つ、455が2つ、255が2つとか、

 455が4つ、255が2つというのも正解ということなんでしょうか?

 プログラムで組めないことはないですが、式でとなるとちょっと...

 他の人にバトンタッチ。

 (ramrun)


 できましたァ。(kazu)

 [ツール]メニュー→[マクロ]→[VisualBasicEditor]を選択します。

 画面が変わったら、[挿入]メニュー→[標準モジュール]を選択します。

 ここに下のマクロをコピーして貼り付けます。

 Excelワークシートに戻って

 セルF1 に 2330、セルA1 に 910、セルB1 に 455、セルC1 に 255

 セルD1 に 140、セルE1 に 60と入力してから

 [ツール]メニュー→[マクロ]→[マクロ]でcalcを選択すると、

 セルA2から下に答えがずらっと出ます。

 0	0	2	1	28

 0	0	2	4	21

 0	0	2	7	14

 0	0	2	10	7

 0	0	2	13	0

 0	0	6	1	11

 0	0	6	4	4

 0	1	1	0	27

 0	1	1	3	20

 0	1	1	6	13

 0	1	1	9	6

 0	1	5	0	10

 0	1	5	3	3

 0	2	0	2	19

 0	2	0	5	12

 0	2	0	8	5

 0	2	4	2	2

 0	3	3	1	1

 0	4	2	0	0

 1	0	0	2	19

 1	0	0	5	12

 1	0	0	8	5

 1	0	4	2	2

 1	1	3	1	1

 1	2	2	0	0

 2	0	2	0	0

 Sub calc()

 Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer, wans As Integer

 Dim r As Integer, c As Integer

 Dim ans As Integer, v1 As Integer, v2 As Integer, v3 As Integer, v4 As Integer, v5 As Integer

 ans = Cells(1, 6) ' セルF1 = 2330

 v1 = Cells(1, 1) ' セルA1 = 910

 v2 = Cells(1, 2) ' セルB1 = 455

 v3 = Cells(1, 3) ' セルC1 = 255

 v4 = Cells(1, 4) ' セルD1 = 140

 v5 = Cells(1, 5) ' セルE1 = 60

 r = 2

 c = 1

 For i = 0 To Int(ans / v1) + 1

     For j = 0 To Int(ans / v2) + 1

         For k = 0 To Int(ans / v3) + 1

             For l = 0 To Int(ans / v4) + 1

                 For m = 0 To Int(ans / v5) + 1

                     wans = v1 * i + v2 * j + v3 * k + v4 * l + v5 * m

                     If wans = ans Then

                         Cells(r, c) = i

                         Cells(r, c + 1) = j

                         Cells(r, c + 2) = k

                         Cells(r, c + 3) = l

                         Cells(r, c + 4) = m

                         r = r + 1

                    End If

                  Next m

             Next l

         Next k

     Next j

 Next i

 End Sub


ありがとうございます。答えでましたが、2330のところを色んな数字を入力してマクロを使うと例えば2330の答えが70行あるとして850の答えが2行しかない場合上書きされて表示されるのですが、2行の残りの68行がシート上に2330の答えが残って表示されてしまうのです。丸ごとかきかえれますか?それと最終行のデータだけが必要なのです。それだけを表示させる方法はありますか?宜しくお願いします。


 とりあえず簡単に100行クリアするロジックを追加しました。

 もし最後の答えだけで良いのなら、『r = r + 1』をコメントにすればできます。

 (kazu)

 Sub calc()

 Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer, wans As Integer

 Dim r As Integer, c As Integer

 Dim ans As Integer, v1 As Integer, v2 As Integer, v3 As Integer, v4 As Integer, v5 As Integer

 ans = Cells(1, 6) ' セルF1 = 2330

 v1 = Cells(1, 1) ' セルA1 = 910

 v2 = Cells(1, 2) ' セルB1 = 455

 v3 = Cells(1, 3) ' セルC1 = 255

 v4 = Cells(1, 4) ' セルD1 = 140

 v5 = Cells(1, 5) ' セルE1 = 60

 r = 2

 c = 1

 For r = 2 to 100

     Cells(r, c) = 0

     Cells(r, c + 1) = 0

     Cells(r, c + 2) = 0

     Cells(r, c + 3) = 0

     Cells(r, c + 4) = 0

 Next i

 For i = 0 To Int(ans / v1) + 1

     For j = 0 To Int(ans / v2) + 1

         For k = 0 To Int(ans / v3) + 1

             For l = 0 To Int(ans / v4) + 1

                 For m = 0 To Int(ans / v5) + 1

                     wans = v1 * i + v2 * j + v3 * k + v4 * l + v5 * m

                     If wans = ans Then

                         Cells(r, c) = i

                         Cells(r, c + 1) = j

                         Cells(r, c + 2) = k

                         Cells(r, c + 3) = l

                         Cells(r, c + 4) = m

                         r = r + 1

                    End If

                  Next m

             Next l

         Next k

     Next j

 Next i

 End Sub


いつも答えが早くてすばらしいです。

たびたびすみません。

そのままコピーして貼り付けて使わせてもらってるんですが、マクロの実行にすると「コンパイルエラー  Nextで指定された変数の参照が不正です」と表示されるのですが。

『r = r + 1』をコメントにすればできます←これはどうやれば良いですか?

お忙しいと思いますが、宜しくお願いします。


 スミマセン。テストもせずに書き込んでしまいました。

 訂正版を下へ書きます。誤『Next i』正『Next r』です。

 コメントは先頭に『'』シングルクオーテーション(SHIFT+7)を入れます。

(kazu)

 Sub calc()

 Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer, wans As Integer

 Dim r As Integer, c As Integer

 Dim ans As Integer, v1 As Integer, v2 As Integer, v3 As Integer, v4 As Integer, v5 As Integer

 ans = Cells(1, 6) ' セルF1 = 2330

 v1 = Cells(1, 1) ' セルA1 = 910

 v2 = Cells(1, 2) ' セルB1 = 455

 v3 = Cells(1, 3) ' セルC1 = 255

 v4 = Cells(1, 4) ' セルD1 = 140

 v5 = Cells(1, 5) ' セルE1 = 60

 r = 2

 c = 1

 For r = 2 to 100

     Cells(r, c) = ""

     Cells(r, c + 1) = ""

     Cells(r, c + 2) = ""

     Cells(r, c + 3) = ""

     Cells(r, c + 4) = ""

 Next r

 r = 2

 For i = 0 To Int(ans / v1) + 1

     For j = 0 To Int(ans / v2) + 1

         For k = 0 To Int(ans / v3) + 1

             For l = 0 To Int(ans / v4) + 1

                 For m = 0 To Int(ans / v5) + 1

                     wans = v1 * i + v2 * j + v3 * k + v4 * l + v5 * m

                     If wans = ans Then

                         Cells(r, c) = i

                         Cells(r, c + 1) = j

                         Cells(r, c + 2) = k

                         Cells(r, c + 3) = l

                         Cells(r, c + 4) = m

                         ' r = r + 1

                    End If

                  Next m

             Next l

         Next k

     Next j

 Next i

 End Sub


ありがとうございます!!ばっちりできました。またわからないことがあれば質問させてもらいます。宜しくおねがいします。


またまた質問です。

マクロででた答えをこたえがでるたびに別のシートにうつしたいのですが。例えば、

          910 455 255 140 60

1回目の入力→2330  1  0  2  0  0

2回目の入力→3140  2  0  4  0  5

3回目

というような感じにしたいのですが。最後にそれぞれの集計をしたいので。ややこしいことをいってすみません。宜しくおねがいします。


 作り直しました。

 ばたばたしていて、オーバーフローする場合があるなど

 テストがまだ完全ではありませんが。 

 セルB1 に 910、セルC1 に 455、セルD1 に 255

 セルE1 に 140、セルF1 に 60と入力します。

 セルA1 に 2330、セルA2 に 2530、セルA3 に 600と入力して、

 この範囲を選択します。

 [ツール]メニュー→[マクロ]→[マクロ]でCellRangeを選択すると、

 新しいシートのセルA2からF2に答えが出ます。

 一度実行すると、シートの名前を2330などと変更したので、

 2回目からは前回のシートを削除する必要があります。

 (kazu)

 Sub CellRange()

 Dim cl As range

 For Each cl In Selection

     calc cl.Value

 Next

 End Sub

 Sub calc(ans)

 Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer, wans As Long

 Dim r As Integer, c As Integer

 Dim v1 As Integer, v2 As Integer, v3 As Integer, v4 As Integer, v5 As Integer

 v1 = Sheets("Sheet1").Cells(1, 2) ' セルB1 = 910

 v2 = Sheets("Sheet1").Cells(1, 3) ' セルC1 = 455

 v3 = Sheets("Sheet1").Cells(1, 4) ' セルD1 = 255

 v4 = Sheets("Sheet1").Cells(1, 5) ' セルE1 = 140

 v5 = Sheets("Sheet1").Cells(1, 6) ' セルF1 = 60

 Sheets.Add

 ActiveSheet.Select

 ActiveSheet.Name = ans

 c = 1

 r = 2

 ActiveSheet.Cells(r, c) = ans

 For i = 0 To Int(ans / v1) + 1

     For j = 0 To Int(ans / v2) + 1

         For k = 0 To Int(ans / v3) + 1

             For l = 0 To Int(ans / v4) + 1

                 For m = 0 To Int(ans / v5) + 1

                     wans = v1 * i + v2 * j + v3 * k + v4 * l + v5 * m

                     If wans = ans Then

                         ActiveSheet.Cells(r, c + 1) = i

                         ActiveSheet.Cells(r, c + 2) = j

                         ActiveSheet.Cells(r, c + 3) = k

                         ActiveSheet.Cells(r, c + 4) = l

                         ActiveSheet.Cells(r, c + 5) = m

                    End If

                  Next m

             Next l

         Next k

     Next j

 Next i

 End Sub

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.