[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『四捨五入のまるめ計算について』（Nyal）
例えば、
A B(A1/計､%)
1 21 30.43（数式=round(A1/A$3*100,2)
2 23 33.33（同上）
3 25 36.23 (同上）
4 69 99.99 (合計欄。Sum計算）
という表があるとき、Round関数を使わなければ、合計だけ丸め計算されて100.00になりますが、そうではなくて、B1～3で一番小数点第3位が0.005に近いものから丸め計算を行い、結果としてB4合計が100.00になるようにしたいのです。
現在C列に
=ABS(ROUND(A1/A$4*10000,3)-INT(A1/A$4*10000)-0.5)
D列に
=RANK(C1,C$1:C$3,2)
E列に
=IF(A1/A$4*10000-INT(A1/A$4*10000)<0.5,"切上対象","切下対象")
（この場合、3つとも切下げ対象なので、一番順位が下のB3が切上げ対象になり、36.24に手入力で変更して、B4合計欄を100.00にする。）
と3列使いどこを丸めればいいかをチェックしているのですが、表もたくさんあり、
いちいち3列も入力するのは大変なので、何か簡単な方法はないでしょうか。
Ｂ欄に下の式を
=IF(A1="","",IF(AND(C$4<1,E1="切り上げ対象",D1=MAX(D$1:D$3)),ROUND(A1/A$4*100,2)+0.01,IF(AND(C$4>0,E1="切り下げ対象",D1=MIN(D$1:D$3)),ROUND(A1/A$4*100,2)-0.01,ROUND(A1/A$4*100,2)))) Ｃ欄にしたの式を =ABS(ROUND(A1/A$4*10000,3)-INT(A1/A$4*10000)) ＢのTOTAL欄に下の式を 入力して下さい =IF(SUM(B1:B3)=0,"",IF(AND(C$4>0,SUM(B1:B3)<100),SUM(B1:B3)+0.01,SUM(B1:B3))) どうやっても100%はカバーでけまへんから（Ｂ欄が全て33.33等の場合）合計欄で無理 矢理100%になる様設定してありまっせぇ。それと合計欄に100.01とか100%を超える数字 が出た場合は面倒でもＣ４に０以外の任意の数字を打ち込んでおくんなはれ。 それ以上はマクロでも使わなあきまへんわ、多分、おそらく、Perhaps。 （おいぼれ弥太郎） なんや画面が妙になってまいましたわ、見難いけどカンニン。
上記の数式で試してみたのですが、うまくいきません。
B列の、AND(C$4<1,E1="切り上げ対象",D1=MAX(D$1:D$3))は、E1が切上対象、
かつDの順位が全体のMaxという意味ですよね。
ただ、MAX(D$1:D$3)は普通切下対象ですし、MIN(D$1:D$3)は切上対象になります。
Rankで、切り下げの場合と切り上げの場合を分けるような数式が必要になってくると思うのですが。
ちなみに、この掲示板の改行がうまくいかないんですが、どうすればいんでしょ。（Nyal）
え～っ！ コレはもう何十辺、いや百回も超える程テストして万全を期した上カキコ しましたんやでぇ。今もファイルを引っ張り出して何度かテストしてみましたけど完璧 ですがなぁ？ Ｃ４のセルは常に空になってまっか？ この式は100%に満たない場合はmax つまりランクの最下位が切り上げ対象やったら+0.0 1を加えなさいになってますさかい、空の状態でなければあきまへんでぇ。 逆に100%を超えた場合、このＣ４に任意の数字（０以外）を入力すればそれを見たＢ列 の連中がmin つまりRANKの最上位が参加して0.01切り下げるようになってますねん。 それでもRANKが三者同一の場合はＢ列ではよう判断しまへんからB4だけで100%になるよ う設定してあります。 Ｃ列の書式設定は小数点３位になってまっか？ もう一回書いときますんで（おそらく間違いはおまへん）確認しておくんなはれ。
=IF(A1="","",IF(AND(C$4<1,E1="切り上げ対象",D1=MAX(D$1:D$3)),ROUND(A1/A$4*100,2)+0.01,IF(AND(C$4>0,E1="切り下げ対象",D1=MIN(D$1:D$3)),ROUND(A1/A$4*100,2)-0.01,ROUND(A1/A$4*100,2))))
=ABS(ROUND(A1/A$4*10000,3)-INT(A1/A$4*10000))
=IF(SUM(B1:B3)=0,"",IF(AND(C$4>0,SUM(B1:B3)<100),SUM(B1:B3)+0.01,SUM(B1:B3)))
（おいぼれ弥太郎）
ごめん、ごめん Ｄ列も式変えてましたわ。 =RANK(C1,C$1:C$3,1) 間に合うたかいなぁ。
今ひょっと気付きましたんやけど、切り上げ、切り下げの優先順位が同位の場合どれか に.001を加えるなり低なりして、合計を100%にしなさいっちゅうことでっか？ 私にはどれを優先すべきか分かりまへんさかい、そう言う施しはしてまへんけど.... 各列33.3%でRANKも同位やったとしますわなぁ。合計欄を単に100%に直すんやなしに 例えばＢ１を33.4%にするっちゅうことでっか？ それやったら又式を考え直さなあきまへんわ、その場合は面倒でも手入力にするという てもあるこっちゃしなぁ。 >この掲示板の改行がうまくいかないんですが これホンマに入力しにくいんですわ、えぇ。わたしもてこずってます。 ほな（おいぼれ弥太郎）
なお、境目が同率の場合は、無理矢理途中をあわせなくてもいいです。（実際は境目が同率という偶然はほとんど考えられません）
統計上の原則は、最大数の項目でまるめますが、なぜか決算関係では一番境目に近いところで丸めるとか・・・面倒な処理がいるんです。
Nyalさんもう仕事終わって帰りはった？ 原因は分かりましたで、えぇ。例題の標本が少なすぎてこんな式（あまりにも長すぎて 削りの削った結果）になってもたんですけど（それでも上手い事いった）、この式確 かに標本が増えたらあきまへんわ、えぇ。削った中の一部が必要になりましたんやけ ど、さあそれがどないな式やったかちょっと思い出せまへん。とにかく循環参照に制 限されてますさかいなかなか骨が折れますねん。 今日はもう一杯飲んでまいましたさかいダウンでッけど、明日は暇有りますさかい な、明日まで待っておくんなはれや。いや、それともNyalさんとどっちがはよ見つけ るか競争するんも面白おまんなぁ。基本の式はあの式でッせぇ。たまには老いぼれと 戯れてみるんも一興でっせ。 ほな（おいぼれ弥太郎）
飛び入り参加させて下さい。頭の中がウニウニになりながら考えてみました。 条件が複雑すぎて簡略化出来てませんが、こんなのはどうですか？ 切上・切下の条件を正確に把握しているかが問題ですが・・・ ※E列の =IF(A1/A$4*10000-INT(A1/A$4*10000)<0.5,"切上対象","切下対象") は =IF(A1/A$4*10000-INT(A1/A$4*10000)<0.5,"切下対象","切上対象")ですよね？ 違っていれば、下の式は修正が必要です。
C列の式は、同率の確率をより下げる為に =ABS(A1/A$4*10000-INT(A1/A$4*10000)-0.5) DE列を逆にしました。 D列には、100未満または超える場合にのみ条件に該当する『切上（切下）対象』を表示させます。 =IF(B$4<100,IF(A1/A$4*10000-INT(A1/A$4*10000)>=0.5,"切上対象","×"), IF(B$4>100,IF(A1/A$4*10000-INT(A1/A$4*10000)<0.5,"切下対象","×"),"")) E列も同様に切上・切下に該当する場合のみ、RANK付けさせます。 =IF(B$4<100,IF(COUNTIF(D$1:D$3,"切上対象")>0,IF(D1="切上対象",RANK(C1,C$1:C$3,0),""),RANK(C1,C$1:C$3,1)), IF(B$4>100,IF(COUNTIF(D$1:D$3,"切下対象")>0,IF(D1="切下対象",RANK(C1,C$1:C$3,0),""),RANK(C1,C$1:C$3,1)),"")) F列で最終的な丸め数字に仕上、F4はSUM関数で100になるはずです。 =IF(B$4=100,"",IF(E1=MAX(E$1:E$3),(100-B$4)+B1,B1)) →B列にまとめたい場合は、F列をコピーB列に値を貼り付けて下さい。 また、同率問題が起こる可能性はあります。(sin)
Sin様、E列は元の数式が正しいです。小数点3位が0.005以下（例24.7649）なら、 四捨五入で数字を切り捨てているので、まるめ計算上は切上対象になります。
で、上記の数式なら確かにいけそうですね。
弥太郎様、昨日家で思いついた数式でうまくいったので、せっかくなのでのせます。ちょっと合計欄が16列目になってますがご容赦を
B列：=IF(A1="","",IF(AND(F$16<100,E1="切上対象",D1=MAX(D$1:D$15)),ROUND(A1/A$16*100,2)+0.01,IF(AND(F$16>100,E1="切下対象",D1=MIN(D$1:D$15)),ROUND(A1/A$16*100,2)-0.01,ROUND(A1/A$16*100,2))))
B16（Total)：=SUM(B1:B15)
C列：=ABS(ROUND(A1/A$16*10000,3)-INT(A1/A$16*10000))
D列：=IF(E1="切下対象",RANK(C1,C$1:C$15,1)-COUNTA(A$1:A$15),RANK(C1,C$1:C$15,1))
・・・この数式で、最下位は切下対象、最上位は切上対象になる
E列：=IF(A1/A$16*10000-INT(A1/A$16*10000)<0.5,"切上対象","切下対象")
F列：=ROUND(A1/A$16*100,2)
書式：=B1<>ROUND(A1/A$16*100,2) 色づけ
あと、この数式を基本に、合計が100.02や100.03になる場合と、全てが切上（切下）対象となる場合（例文等）と、まるめ対象が同率になった場合はA欄の数字が大きい方を優先するといったIf文を入れれば完全になりますが、これは瑣事ですね。
書いてて気づきましたが、D列をこうすると、「切上対象」「切下対象」という文言は不要になりますね。改良します。
B列：=IF(A1="","",IF(AND(E$16<100,D1=MAX(D$1:D$15)),ROUND(A1/A$16*100,2)+0.01,IF(AND(E$16=99.98,D1=MAXA(D$1:D$15)-1),ROUND(A1/A$16*100,2)+0.01,IF(AND(E$16>100,D1=MIN(D$1:D$15)),ROUND(A1/A$16*100,2)-0.01,IF(AND(E$16=100.02,D1=MINA(D$1:D$15)+1),ROUND(A1/A$16*100,2)-0.01,ROUND(A1/A$16*100,2))))))
C列：=ROUND(A1/A$16*10000,3)-INT(A1/A$16*10000)
D列：=IF(A1/A$16*10000-INT(A1/A$16*10000)<0.5,RANK(C1,C$1:C$15,1),RANK(C1,C$1:C$15,1)-COUNTA(A$1:A$15))
E列：=ROUND(A1/A$16*100,2) （そのまま）
これで、99.98と100.02の場合にも対応でき、全てが切下、切上の場合にも対応できました。（Nyal)
わちゃ～ッ、やられたっ！ Nyalさんが仕事の片手間に、わたしゃねじりはちまきで没頭する。これで丁度ええハン ディやと思うとりましたが、あっさりケリ付けられましたなぁ。
>昨日家で思いついた数式 アカンがな、これルール違反やがな。 なにせほら、やたらカッコが多いし、循環参照にもひっかってきますさかい頭ぐちゃぐ ちゃになってもて、挙げ句アシスタントの無能冴子嬢が髪振り乱してエラーメッセージ を鼻先に突きつけてきまんねんで、えぇ。 せっかくココまで来たんやさかい、もうちょっと勉強してみまっさ。もしええのがでけ たらカキコしときますさかい、又覗いてみておくんなはれ。アカンやろ、多分....
sinさんっ！ 後から参加してきたうえ、さっとええとこ取りしてっ！ カキムシったろかしらん！ ほな（おいぼれ弥太郎）
ただ、かなり無駄がありそうですし、同率の場合にA欄の大きい方で丸めるとか残ってて完璧ではないので、またいいのができたら教えてくださいね。（Nyal)
条件やはり取り違えてましたか。読解力に欠けると常日頃から言われております。 弥太郎さん 『柿をむしったら←ドヤされますよ』。私も分配までは追いつきました（と思います）。 誤差0.04までは（0.04以上の誤差は0.04と同じ扱いにしています）同率でない限り計算されるはずです。 あらためて式を羅列します。 B1 =ROUND(A1/$A$16*100,2) B16は、微妙な誤差(バグ?らしい)が出ているようなので =INT(SUM(B1:B15)*100)/100 としました。 C1 =IF(B$16=100,"",ABS(A1/$A$16*10000-INT(A1/$A$16*10000)-0.5)) D1 =IF(B$16>100,IF(A1/A$16*10000-INT(A1/A$16*10000)>=0.5,"切下対象",""), IF(B$16<100,IF(A1/A$16*10000-INT(A1/A$16*10000)<0.5,"切上対象",""),"")) Nyalさん ↑と↓ で合ってますよね（未だ自信がない・・・） E1 =IF(B$16<100,IF(COUNTIF(D$1:D$15,"切上対象")>0,IF(D1="切上対象",RANK(C1,C$1:C$15,1),""),RANK(C1,C$1:C$15,0)), IF(B$16>100,IF(COUNTIF(D$1:D$15,"切下対象")>0,IF(D1="切下対象",RANK(C1,C$1:C$15,1),""),RANK(C1,C$1:C$15,0)),"")) F1 =IF(B$16=100,"",IF(G$1=1,IF(E1=LARGE(E$1:E$15,1),B1+G$3,B1), IF(G$1=2,IF(OR(E1=LARGE(E$1:E$15,1),E1=LARGE(E$1:E$15,2)),B1+G$3,B1), IF(G$1=3,IF(OR(E1=LARGE(E$1:E$15,1),E1=LARGE(E$1:E$15,2),E1=LARGE(E$1:E$15,3)),B1+G$3,B1), IF(OR(E1=LARGE(E$1:E$15,1),E1=LARGE(E$1:E$15,2),E1=LARGE(E$1:E$15,3),E1=LARGE(E$1:E$15,4)),B1+G$3,B1))))) 今回の追加項として、以下の3項を設けました。G2は、同率対策用に仮設定しています。 G1 =IF(B$16=100,"",ABS(B$16*100-10000)) G2 =IF(B$16=100,"",COUNTIF(E$1:E$15,MAX(E$1:E$15))) G3 =IF(B$16=100,"",IF(B$16>100,-0.01,0.01)) 同率問題が解決しましたら（考え付く事が出来れば）、報告します。(sin)
あと同率問題は、どう考えても循環参照になりそうですね。（Nyal)
あっと、すっかりとんでました。ごめんなさい。 同率問題を解決するには、新たに列挿入し、OFFSET関数でA列の数値を引っ張って、大小を確認する という方法で考え中ですが、関数ネストの問題もあり、頭の中がぐちゃぐちゃになってます。今しばらく、時間が掛かりそうです。 その間に、沈黙している弥太郎さんがドカンと解決方法を出してくれそうな気がします。(sin)
>弥太郎さんがドカンと解決方法を出してくれそうな 何を仰有るなんとやら....でっせ。実情を明かしますと、コレはっちゅう方法を見つけ ましてな、嬉々としてサンプルを１５行に広げたら「アウトーッ！」って審判に手ぇ挙 げられましたわ、えぇ。頭柿むしりましたでホンマ...（あらっ？） で、もう関数に挑戦するんはその時点であきらめましたわ。あの(((()))))は見とうお まへんっちゅうのが偽らざる心境です、ハイ。
結論として、若干の不満は残ってもsinさんやNyalさんのお考えになった式で押してい （この場合 原作-おいぼれ弥太郎 脚色-sin Nyal っちゅう注釈書きが必要)くか、 マクロボタンを作ってマクロの作業をさすかになりまんなぁ。
マクロにやらせるとしても条件によって組み方が変わってきますさかいなぁ。 １ Ａ列の数値は頻繁に変わるもんかどうか ２ Ｂ列に関数が必要なモンかどうか（マクロで切り上げ切り下げ作業すると消える） ３ Ｃ列～Ｅ列は表示不要なもんかどうか ４ 表の上下左右を（上端、左端はこの限りでない）空白セルで囲まれているかどうか と、言った案配に、それが分からんことには手ぇつけられしまへんさかいナ。
まあ、あれですわ、関数の作業は潔く Give Up 宣言しますわ...chikusyou! （おいぼれ弥太郎）
試行錯誤の上、こんなになってしまいました。計算式の入力が面倒なので、列が増えてしまいましたが、見てやって下さい。 訳分からなくなるので、A列からいきます。 A1:A15に数値データを入力、A16に =SUM(A$1:A$15) B1:B15に =ROUND(A1/$A$16*100,2) 、B16は =INT(SUM(B1:B15)*100)/100 C1:C15に =ABS(A1/$A$16*10000-INT(A1/$A$16*10000)-0.5) D1:D15に =IF(B$16>100,IF(A1/A$16*10000-INT(A1/A$16*10000)>=0.5,"切下対象","切下対象-ｳﾗ"), IF(B$16<100,IF(A1/A$16*10000-INT(A1/A$16*10000)<0.5,"切上対象","切上対象-ｳﾗ"),"")) E1:E15に =IF(B$16<100,IF(COUNTIF(D$1:D$15,"切上対象")>0,IF(D1="切上対象",RANK(C1,C$1:C$15,1),""),IF(D1="切上対象-ｳﾗ",RANK(C1,C$1:C$15,0),"")), IF(B$16>100,IF(COUNTIF(D$1:D$15,"切下対象")>0,IF(D1="切下対象",RANK(C1,C$1:C$15,1),""),IF(D1="切下対象-ｳﾗ",RANK(C1,C$1:C$15,0),"")),"")) F1:F15に =IF(B$16=100,"",IF(AND(I$4>0,E1=LARGE(E$1:E$15,1)),1,IF(AND(I$5>0,E1=LARGE(E$1:E$15,2)),2, IF(AND(I$6>0,E1=LARGE(E$1:E$15,3)),3,IF(AND(I$7>0,E1=LARGE(E$1:E$15,4)),4,0))))) G1:G15に =IF(I$1<SUM(I$4:I$7),IF(OR(AND(I$5=0,F1=1),AND(I$6=0,F1=2),AND(I$7=0,F1=3),AND(I$7>1,F1=1)),OFFSET(E1,0,-4),""),"") H1:H15に =IF(I$1=SUM(I$4:I$7),IF(OR(F1=1,F1=2,F1=3,F1=4),B1+0.01*I$2,B1), IF(I$1<SUM(I$4:I$7),IF(G1="",IF(OR(AND(I$7>0,F1=3),AND(I$6>0,F1=2),AND(I$5>0,F1=1)),B1+0.01*I$2,B1), IF(F1=4,IF(G1>=LARGE(G$1:G$15,(I$1-SUM(I$4:I$6))),B1+0.01*I$2,B1), IF(F1=3,IF(G1>=LARGE(G$1:G$15,(I$1-SUM(I$4:I$5))),B1+0.01*I$2,B1), IF(F1=2,IF(G1>=LARGE(G$1:G$15,(I$1-I$4)),B1+0.01*I$2,B1), IF(G1>=LARGE(G$1:G$15,I$1),B1+0.01*I$2,B1))))),IF(F1=0,B1,IF(OR(G1=2,G1=3,G1=4),B1+0.01*$I$2,B1+0.01*INT(I$1/I$4)*$I$3)))) H16は、=SUM(H$1:H$15) I1に =ABS(B$16*100-10000) I2に =IF(B$16>100,-1,IF(B$16<100,1,0)) I4に =IF(I$1>0,COUNTIF(E$1:E$15,LARGE(E$1:E$15,1)),0) I5に =IF(AND(I$1>0,I$4-I$1<0),COUNTIF(E$1:E$15,LARGE(E$1:E$15,2)),0) I6に =IF(AND(I$1>0,I$4+I$5-I$1<0),COUNTIF(E$1:E$15,LARGE(E$1:E$15,3)),0) I7に =IF(AND(I$1>0,I$4+I$5+I$6-I$1<0),COUNTIF(E$1:E$15,LARGE(E$1:E$15,4)),0) で大丈夫だと思うのですが、それと、『とんでました』としてましたが、 前回のものも『全て切上（切下）対象の場合（例文等）』には対応してると思うのですが、○○対象とは、表示しませんが。 今回は一応表示するようにしています。読み込み方を間違っているようですと、D,E列の関数をいじれば大丈夫だと思います。 なお、A列に同数字が存在し、切上・切下げの対象に該当する場合は、微調整が必要な場合があります。 OKが出る事を祈ってます。マクロになると私はお手上げです。弥太郎さん、宜しくお願いします。(sin)
あと、A列に違う数字が入っててさらに同率の例を発見しました。
チェック用にどうぞ。13(0.444)、31(0.444)、44(0.111) の3数の組み合わせです。（Nyal)
Nyalさんのコレで充分っちゅうお言葉もろて、安心しとったんですけど、ほら、後 からの参加者がやれやれ！と焚きつけるもんですさかい、一応組んでみましたんや けど、エライ長いコードになってもて...。 いいええな、「Ｒ１Ｃ１」で式入れたら確認するのに見難うてしょうおまへんやろ う思うて、各列に関数を入れときましたで。確認しておくんなはれ。 と言うのは言い訳で、初級者の組んだマクロはこんなモンですわ、ハイ。
シートの邪魔んならん所へコマンドボタンを２個配置しておくんなはれ。 CommandButton1のCaptionに、まあ「入力」とでもしときまひょか、にコードをコピ ーして、同じく2に「修正」としときまひょか。 それとは別にhanpaのこーどをこぴーしておくんなはれ。 さて、任意の列にサンプルをいくつか書き込んで=sum()で結んでおいて、スタートの セルに（今入力したサンプルの最初の行の右隣）ポインターを移して（ココ重要！）「入力」ボタンをクリックすると必要な個所に関数が入力された状態になりますさか い、サンプルの列を変更してもその数値に対する対応は全てカバーします。
結果が100%にならなくて切り上げ切り下げ作業で条件を満たしたい場合はそのセル（ つまり２列目のsum関数が入っているセル、コレも重要！）にセルポインターを移して クリックすれば100%になるまで作業を繰り返して終了します。 左、上下は１列、１行（但し最上段、左端はこの限りではない）右は３列の空間が欲し いんと、セルポインターを合わせるのをお忘れ無く。
この場合、３、４列に入力がなければ修正済みで、入力が有れば実質計算になっとる事
ですなぁ。コードの中の矢印の或る欄の先頭に’を付けると３，４列はそのままになり
ますさかい それでどんな案配に作業しとるんか確認してみておくんなはれ。
同率の最上位の問題はまだよう解決してまへんでぇ、念のため。
----
Private Sub CommandButton1_Click()
hanpa
End Sub
----
Private Sub CommandButton2_Click()
’下に修正後のコード有り
End Sub
-----
Sub hanpa()
Dim stc As Variant
Dim m, i, s, n, cent As Integer
Dim stcel, stcel_a, kiri, kiri_a, rnk, rnk_a As Variant
Dim imaoka, adrs, ads As String
Set stc = ActiveCell.CurrentRegion
cent = stc.Rows.Count
adrs = ActiveCell.Address(rowabsolute:=True, columnabsolute:=False)
ads = ActiveCell.Address(ReferenceStyle:=xlR1C1)
adrs_a = Application.WorksheetFunction.Find("$", adrs, 1)
If adrs_a = 2 Then
adrs_a = Left(adrs, 1)
Else
adrs_a = Left(adrs, 2)
End If
ActiveCell.Offset(0, -1).Activate
stcel = ActiveCell.Address(rowabsolute:=True, columnabsolute:=False)
stcel_a = Application.WorksheetFunction.Find("$", stcel, 1)
If stcel_a = 2 Then
stcel_a = Left(stcel, 1)
Else
stcel_a = Left(stcel, 2)
End If
ActiveCell.Offset(0, 2).Activate
kiri = ActiveCell.Address(rowabsolute:=True, columnabsolute:=False)
kiri_a = Application.WorksheetFunction.Find("$", kiri, 1)
If kiri_a = 2 Then
kiri_a = Left(kiri, 1)
Else
kiri_a = Left(kiri, 2)
End If
ActiveCell.Offset(0, 1).Activate
rnk = ActiveCell.Address(rowabsolute:=True, columnabsolute:=False)
rnk_a = Application.WorksheetFunction.Find("$", rnk, 1)
If rnk_a = 2 Then
rnk_a = Left(rnk, 1)
Else
rnk_a = Left(rnk, 2)
End If
m = Application.WorksheetFunction.Find("C", ads, 1)
i = CInt(Mid(ads, 2, m - 2))
s = Len(ads)
n = CInt(Right(ads, s - m))
imaoka = stcel_a & i & "/" & stcel_a & "$" & cent + i - 1
Range(adrs) = "=round(" & imaoka & "*100,2)"
Range(adrs).Copy Destination:=Range(Cells(i, n), Cells _
(cent + i - 2, n))
Cells(cent + i - 1, n) = "=sum(" & adrs_a & i & ":" & adrs_a & _
cent + i - 2 & ")"
Range(Cells(i, n + 1), Cells(cent + i - 1, n)).NumberFormatLocal _
= "0.00_ "
Range(Cells(i, n + 1), Cells(cent + i - 2, n + 1)).NumberFormatLocal _
= "0.000_ "
Range(kiri) = "=IF(ABS(ROUND(" & imaoka & "*10000,3)-INT(" & imaoka _
& "*10000))>0.5,-(ROUND(" & imaoka & "*10000,3)-INT(" & imaoka _
& "*10000)),ROUND(" & imaoka & "*10000,3)-INT(" & imaoka _
& "*10000))"
Range(kiri).Copy Destination:=Range(Cells(i, n + 1), Cells _
(cent + i - 2, n + 1))
Range(Cells(i, n + 2), Cells(cent + i - 2, n + 2)) _
.NumberFormatLocal = "G/標準"
Range(rnk) = "=IF(" & kiri_a & i & "<0,RANK(" & kiri_a _
& i & "," & kiri_a _
& "$" & i & ":" & kiri_a & "$" & cent + i - 1 & ",1),"""")"
Range(rnk).Copy Destination:=Range(Cells(i, n + 2), Cells _
(cent + i - 2, n + 2))
End Sub
書き込み、っと思ったら ↑ 見慣れないコードが・・・ やはり弥太郎さんでした。私は、チェックしてませんが（長すぎて理解を超えているので！） バッチシだと思います。 >13(0.444)、31(0.444)、44(0.111) の3数の組み合わせ の件ですが、対象数字が上の３個の場合と言うことでしょうか？ これだと、B列が 14.77、35.23、50.00 で合計が100になると思いますが・・・ 基本的にB16の合計が、100になる場合は、C列以降はただの落書きと同じです。 今回の式で微調整（手作業）が必要なのは、 I$1>SUM(I$4:I$7)の条件下でF列が１でA列が同数字の場合だけのはずです。（思い込んでいるだけかも？） それと、前回のものが、やはり上手く動かない様ですが、計算式を壊して、再現するのも面倒なので、忘れて下さい。 それにしても、弥太郎さんの怨念（？）には感服します。(sin)
右隣ッちゅうんが抜けてましたんで入れときました。ごめん、ごめん。 （何やってもドジな弥太郎）
すいません。前回の書き間違えです。 13,31,46です。 マクロについては、現在入門書開いて勉強中です。（Nyal)
原因わかりました。データが少なすぎて、F列に『4』が存在しなかった為です。 元の式（データ数15）のF1を =IF(B$16=100,"",IF(AND(I$4>0,E1=LARGE(E$1:E$15,1)),1, IF(AND(I$5>0,IF(MAX(E$1:E$15)>=2,E1=LARGE(E$1:E$15,2),FALSE)),2, IF(AND(I$6>0,IF(MAX(E$1:E$15)>=3,E1=LARGE(E$1:E$15,3),FALSE)),3, IF(AND(I$7>0,IF(MAX(E$1:E$15)>=4,E1=LARGE(E$1:E$15,4),FALSE)),4,0))))) 13,31,46の3個のデータで試す場合には、F1を =IF(B$4=100,"",IF(AND(I$4>0,E1=LARGE(E$1:E$3,1)),1, IF(AND(I$5>0,IF(MAX(E$1:E$3)>=2,E1=LARGE(E$1:E$3,2),FALSE)),2, IF(AND(I$6>0,IF(MAX(E$1:E$3)>=3,E1=LARGE(E$1:E$3,3),FALSE)),3, IF(AND(I$7>0,IF(MAX(E$1:E$3)>=4,E1=LARGE(E$1:E$3,4),FALSE)),4,0))))) として必要行までコピーして下さい。(sin)
同率問題解決したでえっ！ sinさんもなかなかねばり強いでんなぁ。阪神のスローガン ネバネバネバsinでんな。 こないに押しつけてええんやろか？迷惑しとんとちゃうやろか？ ほんでも性格が完全主義者やさかい（ドコガ？）カンニンして貰わなしょうおまへんわ
コマンドボタン２だけ差し替えておくんなはれ。function作ったらもっと簡潔かでける んでっしゃろけど危うい所で使えんようになりかけたんで、このままいきまっさ。 とんでもなく重いモンになりましたけどNyalさんが背負うて歩くわけやおまへんし、 まあ、辛抱してやぁ。 （完全主義者の弥太郎）
----
Private Sub CommandButton2_Click()
Dim stc As Variant
Dim cent, m, i, s, n As Integer
Dim adrs As String
'コレ追加
Range(Cells(1, 255), Cells(10, 256)).ClearContents
Set stc = ActiveCell.CurrentRegion
adrs = ActiveCell.Address
Set mc = ActiveSheet.Range(adrs)
adrs = mc.Address(ReferenceStyle:=xlR1C1)
m = Application.WorksheetFunction.Find("C", adrs, 1)
i = CInt(Mid(adrs, 2, m - 2))
s = Len(adrs)
n = CInt(Right(adrs, s - m))
cent = stc.Rows.Count
Cells(i - cent + 1, n).Activate
hanpa
If Right(Cells(i, n), 2) <> 0 Then
s = 0
Select Case Cells(i, n)
Case Is < 100
Set igawa = Range(Cells(i - cent + 1, n + 1), Cells(i - 1, n + 1))
Do While CInt(Right(Cells(i, n), 2)) <> 0
s = s + 1
celdata = Application.WorksheetFunction.Large(igawa, s)
f = Application.WorksheetFunction.Match(celdata, igawa, 0)
x = Application.WorksheetFunction.CountIf(igawa, celdata)
If x > 1 Then
y = 0
Do While y < x
j = j + 1
If celdata = Cells(i - cent + j, n + 1) Then
y = y + 1
Cells(y, 256) = Cells(i - cent + j, n - 1)
Cells(y, 255) = j
End If
Loop
j = 0
Set hosino = Range(Cells(1, 256), Cells(10, 256))
joui = Application.WorksheetFunction.Max(hosino)
f = Application.WorksheetFunction.Match(joui, hosino, 0)
f = Cells(f, 255)
End If
Cells(f + i - cent, n) = Cells(f + i - cent, n) + 0.01
Cells(f + i - cent, n + 1) = Cells(f + i - cent, n + 1) _
+ 0.001
Range(Cells(1, 255), Cells(10, 256)).Clear
Loop
Case Is > 100
Set igawa = Range(Cells(i - cent + 1, n + 2), Cells(i - 1, n + 2))
Do While CInt(Right(Cells(i, n), 2)) <> 0
s = s + 1
celdata = Application.WorksheetFunction.Large(igawa, s)
f = Application.WorksheetFunction.Match(celdata, igawa, 0)
x = Application.WorksheetFunction.CountIf(igawa, celdata)
If x > 1 Then
y = 0
Do While y < x
j = j + 1
If celdata = Cells(i - cent + j, n + 2) Then
y = y + 1
Cells(y, 256) = Cells(i - cent + j, n - 1)
Cells(y, 255) = j
End If
Loop
j = 0
Set hosino = Range(Cells(1, 256), Cells(10, 256))
joui = Application.WorksheetFunction.Max(hosino)
f = Application.WorksheetFunction.Match(joui, hosino, 0)
f = Cells(f, 255)
End If
Cells(f + i - cent, n) = Cells(f + i - cent, n) - 0.01
Cells(f + i - cent, n + 1) = Cells(f + i - cent, n + 1) _
- 0.001
Range(Cells(1, 255), Cells(10, 256)).Clear
Loop
End Select
End If
Range(Cells(i - cent + 1, n + 1), Cells(i - 1, n + 2)).ClearContents
MsgBox "作業終了です"
End Sub
（執念の）弥太郎さん、お疲れ様です。 ボタンでの操作試してみました。マクロが動いているのを見てると、やはりすごいな～と感じます。 han+(sin)の方法との結果照合をしてみました。 切上・切下の対象に該当するものが、逆でした。適当にいじって同じ該当にするとランク付けが逆でした。 私の式も見直してみます。 ここまで来たら、（Nyal)さんから花マルをいただき、祝勝会を開きたいものです。 irabuも入れて欲しかった(sin) より
sinさん、おはようございます。 >ランク付けが逆って私のコードの事でっか？ ３列目から拾い出すのは切り上げ対象でlarge関数で順番に拾い出します。ただ同率の 場合は同率の最上位を切り上げ作業をして次のループに引っかからない順位に押しあげ てあります。４列目は切り下げ対象のみのランク付けで、後にサブルーチンに移動して も同じlarge関数で拾える様ランク付けしてあります。同率の場合は切り下げ作業をし 次のループ外になるよう順位を変えてあります。 それこそ、確認に確認を重ねて作ってありますさかい、自負してまんねんけど、どっか おかしいとこご指摘願えたらありがとうおまんねんけど...
それからirabuの件でッけど、最近調子ワルイぃ！今後の活躍によって検討しますわ。 ほな（おいぼれ弥太郎）
ほんならマクロボタンの登録やってみまひょか。 新しBook開いてみて下さい。 もう作られたから分かってまっしゃろけど念のためにおさらいしまっせ。
コントロールツールボックス→コマンドボタン選択→配置→ダブルクリック でPrivate Sub CommandButton1_Click() End Subが現れる筈ですさかいその間にhan pa つまり中身だけコピぺしてください。 Excelに戻って今度は同じくコマンドボタン２を配置してWクリックでCommandButton2_C lick()の下に中身だけコピぺしてください。 Excelに戻って(Alt+Q)→デザインモードの終了 Alt+F11でコードを表示して、最下行 End Subの下の行に、さっきと違ってSub hanpa() からEnd Sub間でコピぺしてください。コレで作業は終了ですわ、えぇ。 不明な点がおましたらまたカキコしておいておくんなはれ。 （優しさ溢れるや太郎）
>ランク付けが逆って私のコードの事でっか？ 私の場合と逆という事で、しかも、B16が、『 <100』の場合でした。 私も条件面の読解力にまだ自信が持てませんが、合っているという仮説の下で、気付いた点を書きます。 ①ランク付けが、負の数字に対して行われている為、大きい数字（0.5に近い数字）のランクが下になっている。 ②B16が、『 >100』の場合は、切上（『 >0.5』）に"-"が付き切下対象となりますが、 B16が、『 <100』の場合も、切上（『 >0.5』）に"-"が付き切上対象となるため、本来切上対象となる切下（『 <0.5』）が除外されている。 以上『入力ボタン』実行時に書き込まれる、関数式より感じた点です。 合っていると思っている仮説が『違いまっせ！』という時は、ご指摘ください。 (sin) PS 胴上げ投手(?)を入れないと祟られまっせ！
初めにＤ欄はランクを参照するんではなくて、あくまでマクロを実行するのに都合のい いように作ってある、いわば作業台と思っておくんなはれ。ランクから言えば確かに逆 になってますけど、最前も申したようにサブルーチンに作業させる場合small関数を使 わなあかんかったら<0.5 large関数だけで済まん様になってきますわなぁ。せやさかい <0.5を拾うＣ列も>0.5を拾うＤ列も同じlarge関数で拾えるように細工してありまんね ん。本来からすればsinさんの仰有るランクにしてSmall関数で拾うんが筋ですわなぁ。 最初からＣ列Ｄ列を表示するするつもりはおまへんでしたからどっちでもええと思う とりましたさかい....。関数に一家言持つ御方やと気ぃになりますわなぁ、やっぱし、 うん。はい、逆です。認めます。完全主義者が泣きまんなぁ、ホンマに。 ア～ン、イチャモン付けられた～っ！kazuさんこの人どないかしてっ！ （irabuが嫌いになった弥太郎）
=IF(A1/A$16*10000-INT(A1/A$16*10000)<0.5,RANK(C1,C$1:C$15,1),RANK(C1,C$1:C$15,1)-COUNTA(A$1:A$15))
の-COUNTA(A$1:A$15))相当部分が抜けてるような気がします。（Nyal)
P.S. あと、ものによっては二段階切上げされているのがあるみたいです。
例ー33.98884 が、ボタン１(入力）で、33.99になりさらにボタン2(修正）で34.00になっているのがありました。
どうもフに落ちないでっけど、33.98884は33.99と表示されますわなあ。で、切り上げ 対象になるＣ列には-0.884となってこれはD列の切り下げ対象それも、Large関数で拾う 事から申せば相当下位になる事から切り上げにはならない筈なんですがなぁ。あれでっ かボタン２以降データを変更後データを入力してもＢ、Ｃ列には関数の消えた行がおま すさかいな、いっぺんデータ変更前にボタン１で全ての行に式を入れ、それで過不足の 発生した時点で、再確認してみておくんなはらんかなぁ。もし仮におかしいのを発見し たら面倒でッけどそのデータカキコしてくれしまへんか。私が作業した限りでは１度も そんな事は起こりまへんでしたわ、えぇ。頼んどきます。まだ他にも話ありますさかい な。 ほな（おいぼれ弥太郎）
ひぇ～！↑（（Nyal)さん） と言う事は、やはり私の理解間違です。弥太郎さんごめんなさい。 【条件のおさらい】 ↓間違っている点を指摘して下さい。 A1/A$16*10000の小数点以下が、0.5以上をA、未満をBとした時、 B$16＝100は、OK。<100の場合、Aの中で0.5に近いものから切上げてゆき、>100の場合は、Bの中で0.5に近いものから切下げてゆき。 同率の場合は、共にA列の値の大きいものを切上（切下）げる。 また、共に該当するA（B)がない場合は、B(A)の中で、0.5より遠いものから切上（切下）を行う。 どこが、違っているのか教えて下さい。（涙目で訴え、それでもirabu贔屓のsin)
Nyalさんの仰有るとおりにはなりまへん。きちんとでけてまっせぇ。 この場合、切り上げ対象の１番手は２行めで、２番手は１５行目になってますわなぁ ボタン２でこの２行が切り上がって１００％に収まってまっせ。 例の33.99の行はピクリとも動きまへん。sinさん確認お願いでけまへんやろか？ 自信満々の弥太郎
sinさん逆でんがな。0.5以上ちゅうのはその時点でround関数で繰り上がって２列目に 表示されてますさかい切り下げ対象にしかなりまへん。従って私は３列目に-で表示し ました。逆に0.5未満は正味の数字で表示されてさかい、これは切り上げ対象にしかな りまへん。私の３列目の表には正数で表示されています。この数字の高い順から切り上 げていきます。 説明がヘタやさかいご理解頂けたかどうか分かりまへんけど、まあ、そんなところです わ、えぇ。 今日勝ったらirabuのこと考えてみます。弥太郎
弥太郎さん、ご指導ありがとうございます。やっと条件を把握しました。そして同じ結果になりました。 調整される値は、2行目0.11→0.12、9行目0.74→0.75ですよね（？） ちなみに、99.97になり、対象値が1個しかない場合は、どうするんですかね～？ 今回修正した式では、対象外の0.5に近い数字から0.01づつ調整できるはずです。 弥太郎さんのマイナス使用をヒントにさせてもらいました。ゴッツァンデス。 式は、上の結果で『正しい』と（Nyal)さんから言われてからアップします。 弥太郎さんには負けたけど、今日もＶ! (sin)
sinさん、そうでんねん。野球が始まる時間になると気ぃもそぞろになってろくに確認 もせんと２行目、１５行目言うて勝手に決め込んどりましたけど、表を再確認したら 仰有るとおり９行目が切り上げ１番候補で２行目が２番候補になってますわ、えぇ。 この年になると、自分のやっとる事が全て正しいと思えるようになるもんでんねんで。 sinさんもそうでっしゃろ？えっ？違うて？ほんなことおまへんやろぅ、正直に言うて みなはれや。絶対そうなんやから...。と言った案配に...。
>対象値が1個しかない場合は
ご心配に及びまへん。対象値が１個でも逆対象値から最も近い拾い上げるようにセット
してありま。でないと標本が少のうて対象値が偏ったとき困りますさかいなぁ。
今日もＶ、気分よろしなぁ。irabuの件考慮してみまっさ。
ほな（irabuよりスマートな弥太郎）
返事遅うなってごめんやで。
今日は仕事で出かけとったさかいナ。明日も出かけなアカンのんで大事な追加を書く
間がおまへんねん。今書いたらええねんけど実況中継の最中やさかいカンニン。
ほら、いまNyalさんの間違い起こしたセルポインターの件ですわ。
せやから、もう１回このスレ覗いておくんなはれや。返事は要りまへんのんで、....
（野球中継に夢中でirabuファン(uso!)の弥太郎）
熱心な論議に関心を持って拝読させて頂きました。 [[20030102213851]] 『ROUNDUPが0.30になりません』（東北トミ－） A B C D 1 21 30.43 30.43 0.4347826086956560 2 23 33.33 33.33 0.3333333333333290 3 25 36.23 36.23 0.2318840579710160 4 69 99.99 100 1.0000000000000000 B1に =ROUND(A1/$A$4*100,2) この式をB3までコピー、B4 =SUM(B1:B3) C1に =ROUND(A1/$A$4*100,4) この式をC3までコピー、C4 =SUM(C1:C3) D列はC列の値をEXCELが小数点以下15桁でまるめている表示です。 （EXCELでは小数計算をすると、二進数のまるめ誤差が生じるようです。） この補正にB4を =ROUND(SUM(B1:B3),-2) にして強制的に100にするのは？ 参考になるかどうか不安です！ (シニア)
Nyalさん、実は気ぃになってましたんやけど、今のコードではNyalさん以外の方が迂闊 にコマンドボタンを障った時に他の大事なデータを消してしまう恐れがおますさかいに そう言う事の無い様ガードしときましたで、えぇ。まぁ、完璧とは言えまへんけどかな り高い確率で防げると思いますわ。それからテスト回数が少ないんで、ご自分でテスト して一層確率の高いモンにしてもらえたら幸甚です。もし分からん事がおましたらカキ コしといておくんなはれや。 何処障ったかハッキリしまへんので、下のコードに差し替えてもろたら安心ねんけど、 コレも不具合が出たら言うておくんなはれ。 原作 Nyal 脚色 sin 変色 Oibore Yatarou でんな。 勉強のテーマもろて、おおきに
'-------------
コマンドボタン１（入力）
n = CInt(Right(adrs, s - m))
から
If Right(Cells(i, n), 2) <> 0 Then
の間に
cent = stc.Rows.Count
If n = 1 Or Cells(i, n) = "" Then GoTo hiyama
If Cells(i + 1, n) <> "" Or Cells(i, n - 1) = "" Or Cells(i, n) < 1 _
Or Cells(i, n - 1) < 1 Then GoTo hiyama
Cells(i - cent + 1, n).Activate
hanpa
Cells(i, n).Activate
を挿入しておくんなはれ
更に
MsgBox "作業終了です"
～
End Sub
の間に
Exit Sub
hiyama:
MsgBox "２列目合計欄にセルポインターをセットして下さい。"
を挿入
次はhanpaのコードに移って
Else
adrs_a = Left(adrs, 2)
End If
この間に
ActiveCell.Offset(0, -1).Activate
On Error GoTo irabu 'ココ追加
して下さい
あと
n = CInt(Right(ads, s - m))
～
imaoka = stcel_a & i & "/" & stcel_a & "$" & cent + i - 1
の間を下のコードに差し替えて下さい
ActiveCell.Offset(0, -2).Activate
If Cells(i, n) = "" Then
rtn = MsgBox("スタートセル(２列目最上位)にポインターを SET 出来ていますか？", vbYesNo + vbQuestion)
If rtn = vbYes Then
GoTo yano
Else
GoTo irabu
End If
End If
If i > 1 Then
If Cells(i - 1, n) <> "" Or Cells(i, n) < 1 Or Cells(i, n - 1) < 1 _
Or Cells(i, n - 1) = "" Then
GoTo irabu
End If
Else
If Cells(i, n - 1) < 1 Or Cells(i, n) < 1 Or Cells(i, n - 1) = "" Then
GoTo irabu
End If
End If
yano:
ActiveCell.Offset(0, -1).Activate
そして
Range(rnk).Copy Destination:=Range(Cells(i, n + 2), Cells _
(cent + i - 2, n + 2))
～
End Sub
の間に
Exit Sub
irabu:
MsgBox "セルポインターをスタートセル（２列目の最上段）に合わせて下さい"
を挿入しておくんなはれ
'------------------ シニアさん、我々ベビー級の三つどもえ戦をご観覧下さっとったそうで、光栄に存じ ますわ。さぞかし歯がゆい思いしてはった事は想像するに難くおまへん。 誤差の事なんでッけど、正直「なんや妙やなァ」と思わん事はおまへんでしたんやけど わたしゃExcelに全幅の信頼を置いてますさかい、自分の考えが間違うとると判断して 自分の方を丸めて現在に至ってますわ、えぇ。せやけど「妙や」と感ずるこの私、ま んざら捨てたもんや無かったっちゅう事になりまんのかいなぁ、コホン。
まあ、この話、はじめかけたら長うなりますさかい次の機会に譲るとして、今後とも 宜しくお願いします。 （阪神より一足先に胴上げしてもろた弥太郎） sin さん、エラー処理班やけどirabu使うときましたでっ！
修正分を書き加えました。使ってみたら、ポイントあわせミスも減って、かなり使いやすいですね。 これで完璧ですね。（Nyal)
衝突しました。 irabuやっと登場ですね、これで臍も曲げずに最後まで頑張ってくれるでしょう。それにしても強すぎ！ （Nyal)さんも完璧と言われているので、載せる必要も無いのでしょうが、 私も胴上げに混ぜていただこうと思い、諸条件を整理し直して、作り直してみました。 『弥太郎さんのマクロを関数式に直しただけ』と言われても仕方のない式ですが、見てやって下さい。 C列 =A3/$A$16*10000-INT(A3/$A$16*10000)-0.5 D列 =IF(B$16>100,IF(C3>=0,"切下対象",""),IF(B$16<100,IF(C3<0,"切上対象",""),"")) E列 =IF(B$16=100,"",IF(B$16<100,IF(COUNTIF(D$1:D$15,"切上対象")>0, IF(D3="切上対象",RANK(C3,C$1:C$15,1),RANK(C3,C$1:C$15,0)*-1),RANK(C3,C$1:C$15,0)*-1), IF(COUNTIF(D$1:D$15,"切下対象")>0,IF(D3="切下対象",RANK(C3,C$1:C$15,0),RANK(C3,C$1:C$15,1)*-1),RANK(C3,C$1:C$15,1)*-1))) F列 =IF(B$16=100,"",IF(AND(COUNTIF(E$1:E$15,">="&LARGE(E$1:E$15,H$1))>H$1,E3=LARGE(E$1:E$15,H$1)),OFFSET(E3,0,-4),"")) G列 =IF(H$1=0,B3,IF(COUNTIF(E$1:E$15,">="&LARGE(E$1:E$15,H$1))>H$1,IF(OR(E3>LARGE(E$1:E$15,H$1), AND(E3=LARGE(E$1:E$15,H$1),F3>=LARGE(F$1:F$15,H$1-COUNTIF(E$1:E$15,">"&LARGE(E$1:E$15,H$1))))),B3+0.01*H$2,B3), IF(E3>=LARGE(E$1:E$15,H$1),B3+0.01*H$2,B3))) H$1 =ABS(B$16*100-10000) H$2 =IF(B$16>100,-1,IF(B$16<100,1,0)) 多少シンプルになりました。ただ、切上(切下）対象が２個以上有り、A列も同数字だと、全てに対し0.01を加減します。 行位置で処理する事は可能ですが、現状は、手作業処理（人の判断対象）としています。 弥太郎さんのマクロは、100となった時点でストップします。流石です。
>この年になると、自分のやっとる事が全て正しいと思えるようになるもんでんねんで。 sinさんもそうでっしゃろ？ 年齢は別として、『純粋なもので、思い込みが激しい』と訂正します。結果的には同じ事ですが。 それにしても、ここまで来るのに長かったですねぇ！お疲れ様でした。(sin)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.