エクセル計算式、VBAについて

質問

エクセル計算式、VBAについて

下記質問の続きでございます。
http://okwave.jp/qa/q5871637.html

先日の質問にて表もうまく完成したかに見えたのですが、
何度か動作確認のテストをしているうちに、少しおかしな点が出てきました。

下記のURLにある表を見ていただきたいのですが、
加工前の状態から、下記のVBAを実行して、別シートへ加工後の形に出力しました。
※質問文に直接画像を貼りたかったのですが、どういうわけか出来なかったので、
画像URLでのご説明になることをお許し下さい。

※「加工前」
http://f58.aaa.livedoor.jp/~works/4.jpg

※VBAの内容
Sub ボタン1_Click()
With Sheets("加工後")
.Range("2:65536").ClearContents
For i = 2 To Range("A65536").End(xlUp).Row
For j = 1 To Range("D" & i).Value
GYOU = .Range("A65536").End(xlUp).Row + 1
.Range("A" & GYOU).Value = Range("A" & i).Value
.Range("B" & GYOU).Value = Range("B" & i).Value
.Range("C" & GYOU).Value = Range("C" & i).Value
.Range("D" & GYOU).Value = Range("D" & i).Value
.Range("E" & GYOU).Value = j
.Range("F" & GYOU).Value = "111-1111-" & Right("1111" & (i - 1), 4)
.Range("G" & GYOU).Value = GYOU - 1
.Range("H" & GYOU).FormulaR1C1 = _
"=MIN(RC[-5],RC[-6]-SUMIF(R1C[-2]:R[-1]C[-2],RC[-2],R1C[-5]:R[-1]C[-5]))"
Next j
Next i
End With
End Sub

※「加工後」
http://f58.aaa.livedoor.jp/~works/1.jpg

加工後の結果でおかしいのが、「箱内数量」です。
目立つようにピンクと黄色で色分けしました。

H9とH10 は箱内数量が正しい数値ですが、
H18とH19は本来、H18=50、H19＝40 とならなければなりません。
さらに、H22：H24も、H22=50、H23=50、H24=20 となってほしいのです。

”加工前” シートのH列には下記の計算式が入っており、H列下方へ相対参照にて計算式をコピーしています。
=MIN(INDEX(C:C,MATCH(F2,F:F,0)),INDEX(B:B,MATCH(F2,F:F,0))-(ROW()-MATCH(F2,F:F,0))*INDEX(C:C,MATCH(F2,F:F,0)))

”加工後” シートのH列には事前には何も計算式が入ってませんが、VBAを実行することにより、下記の計算式が入り、H列下方へ相対参照にて計算式がコピーされています。
=MIN(C2,B2-SUMIF(F$1:F1,F2,C$1:C1))

なぜうまく結果が出るところと、出ないところがあるのか分かりません。
正常な結果を求めるには、どこを修正すればよろしいでしょうか？

回答No.5

Wendy02 · ベストアンサー

#4の補足のコードを見せていただいて、私がいくつか注意点を申し上げたことを一切無視しています。そうすると、本来、こちらもお答えする必要はないのですが、一応、こちらの回答を書いておきます。もう少し、前向きに、学んでください。他人のマクロの批判はしたくはありませんが、初級レベルのルールを守らないようなコードには手を付けることはできません。マクロは、その人のスキルがはっきり現れます。

'//
Sub ボタン1_Click()
　Dim sh1 As Worksheet
　Dim sh2 As Worksheet
　Dim i As Long, k As Long, j As Long, m As Long, t As Long
　Dim LastR As Long
　Dim BoxNo As Long
　Set sh1 = Worksheets("加工前") '転記前のシート
　Set sh2 = Worksheets("加工後") '転記後のシート

　If IsDate(sh1.Range("I3").Value) Then
　　BoxNo = Format(sh1.Range("I3").Value, "yyyymmdd")
　Else
　　MsgBox "日付がありません。", 48: Exit Sub
　End If
　'転記シートのデータ削除
　With sh2
　　With .UsedRange
　　　.Offset(1).Resize(.Cells.Count, 8).ClearContents
　　End With

　　k = 2 '転記後の書き出し行の初期値
　　LastR = sh1.Cells(Rows.Count, 1).End(xlUp).Row
　　Application.ScreenUpdating = False
　　For i = 2 To LastR
　　　If sh1.Cells(i, 2).Value <= sh1.Cells(i, 3).Value Then
　　　　.Cells(k, 1).Resize(, 5).Value = sh1.Cells(i, 1).Resize(, 5).Value
　　　　.Cells(k, 6).Value = sh1.Cells(i, 6).Value
　　　　.Cells(k, 7).NumberFormat = "00000"
　　　　.Cells(k, 7).Value = BoxNo & Format$(k - 1, "00000")
　　　　If sh1.Cells(i, 3).Value >= sh1.Cells(i, 2).Value Then '元シート計算違いの保護
　　　　　.Cells(k, 8).Value = sh1.Cells(i, 2).Value
　　　　Else
　　　　　.Cells(k, 8).Value = sh1.Cells(i, 3).Value
　　　　End If
　　　　k = k + 1
　　　Else
　　　　m = sh1.Cells(i, 4).Value
　　　　t = sh1.Cells(i, 2).Value
　　　　For j = m To 1 Step -1　'逆転
　　　　　.Cells(k, 1).Resize(, 4).Value = sh1.Cells(i, 1).Resize(, 4).Value
　　　　　If j <> m Then
　　　　　　.Cells(k, 8).Value = sh1.Cells(i, 3).Value
　　　　　Else
　　　　　　.Cells(k, 8).Value = t Mod sh1.Cells(i, 3).Value
　　　　　End If
　　　　 .Cells(k, 5).Value = j
　　　　 .Cells(k, 6).Value = sh1.Cells(i, 6).Value
　　　　 .Cells(k, 7).NumberFormat = "00000"
　　　　 .Cells(k, 7).Value = BoxNo & Format$(k - 1, "00000")
　　　　　k = k + 1
　　　　Next
　　　End If
　　Next
　End With
　Application.ScreenUpdating = True
　'完了後の音
　Beep
End Sub

お礼

おっしゃる通りでございます。
私はほんとに失礼なことをしてしまったと、事の重大さを今になって感じている所です…。
本来であれば、Wendy02様にご教示いただいたVBAにて学ぶべきでありました。
それは私も重々承知しておりましたが、実は非常に申し上げにくい理由がありまして・・・

今回の質問の流れを見ますと、多くのご教示をいただきながら、
回を重ねるごとに改良を加えていって、より完成度の高いものに仕上がってきました。
Wendy02様には、言葉では言い尽くせないほどの感謝の思いでございます。

それだけに・・・
非常に申し上げにくいことがありまして、
実は、Wendy02様にご教示いただきましたVBAを動作致しますと、
基本動作はとても理想の形で良かったのですが、
どういうわけか、意図していない付加的な動作が加わってしまう現象がありまして・・・。

例えばほんとに些細なことなのですが、
加工後シートの罫線が一部（一本だけとか）消えてしまったり、
文字の大きさが一部小さくなってしまったりという現象が起きておりました。

これがVBAの影響によるものなのか、私の操作ミスというか当方に原因があるものなのか、
判断がつかなくて困っていたのです。
そのあたりも本当は質問したかったのですが、
せっかくお時間を割いて作って下さったVBAなのに、
文字がどうとか、罫線がどうとかなんて、細かい所にケチを付けるようなことを言ってしまったら気分を害されるのではないかと思ってしまいまして・・・。
色々と気にし過ぎる性格なもので、どうしようかあれこれ考えていたら、
結局何も言えなくなってしまいまして・・・。

しかしそれが逆にもっと失礼な結果になってしまったことに気付き、今非常に反省しております。
ですので、悪意が無かったということだけはどうかご理解いただけると私も本当に救われる思いです。

あらためて今回ご教示下さいましたVBAで確認してみましたら、
以前のような意図していない動作がウソのように消えていたんです。
やはりあれは当方のなにか原因だったのだろうと思っております。

せっかく手取り足取りご教示下さっているのに、それを踏みにじるようなことをしてしまい、
本当に心から申し訳ございませんでした。

現在は、今まで気になっていた部分が消えましたので、
Wendy02様のVBAに完全に移行出来ました。

私は本当に余計なことまであれこれ考え過ぎてしまう性格なもので・・・
よくないですね、こういうのは。
やっぱり思ってることは正直に話すべきだと思いました。

それで今回いただきましたVBAについてですが、気になる所が2箇所出てきてしまったので、
何度もお手数をお掛けしまして、本当にお聞きしにくいことなのですが、
ここは勇気を持ってお尋ねしたいと思います。

★気になる箇所
１．加工後シートのE列（箱連番（営業所毎））は従来の昇順のままでよかったのですが、今回は降順になってしまいます。

２．仮に「送付する総数量」が150、「1箱の最大入り数」が50 といったように、
端数が出なくて割り切れる数字の場合
50
50
50
となるはずですが、

0
50
50
となってしまいます。

これはどこを修正したらよろしいでしょうか？
念のため、私のエクセルファイルをオンラインストレージにアップロードしました。
気になる箇所を黄色と赤で目立つように色分けしてみました。
参考になりますでしょうか？
http://www.filebank.co.jp/filelink/d82ce4b05aa1f71a44fad4fea1d0cf38

何卒宜しくお願い申し上げます。

回答No.4

Wendy02

BoxNo = Format(Date, "yyyymmdd")
この中のDate というのは、本日(TODAY)のことです。

そうしたら、どこかのセルをひとつ、日付を入れるようにしてあげて、
例えば、ボタンの下の　I3(アイ13） 辺りに置きます。　

BoxNo = Format(Date, "yyyymmdd") '1行を以下の行に替える
　　　↓
　If IsDate(Range("I3").Value) Then
　　BoxNo = Format(Range("I3").Value, "yyyymmdd")
　Else
　　MsgBox "日付がありません。",48:Exit Sub　'←48と書くのは、本来は可読性を落とすので、vbExclamationが正しい
　End If

とすれば、I3 の部分にいれた日付を元に処理されます。

ここまで引っ張りましたので、せっかくですから、私の書いたものと、前の方が書いたものの違いを、見比べてください。私のほうが分かりにくいように思うかもしれませんが、いくつかのVBAプログラマの約束事が含まれいます。
なるべく良書にめぐり合って、それをマネしてください。私は残念ながら、ここの掲示板では、掲示板の改編に伴い、省略して書かざるをえなくなりました。
-----------------------------
　Sheets　と Worksheets は違いがあるということ。
　入門編を過ぎたら、変数の宣言はしてください。ただし、なかなか難しいです。
　.Range("2:65536").ClearContents　これは、本当は、CurrentRegion や　UsedRange を使います。もし、1行目を残したかったら、Offset(1) で下にずらせば済みます。もちろん、セルは、書式も値もない空白領域は、何も存在しません。つまり、ワークシートには、論理的な65536行(Excel2003まで）はあっても、物理的には65536 行までのセルはありません。

　変数のローマ字は極力避けます。

　Range とCellsでは、今回のようなループに入れる場合は、Cellsのほうが優れています。文字 & 数字の型のキャスティングで、文字型に換えるようなコードは避けたほうがよいです。負担が多くなります。

　 .Range("H" & GYOU).FormulaR1C1　は、わざわざ、R1C1 型にする必要はありません。Formula か、FormulaLocal を使います。Local というのは、日本版にしか使えない数式の時に使います。例えば、 "H21/3/10" これを、年月日に読ませたい時に、FormulaLocal を使います。そうでなければ、Formulaだけでよいです。また、 Formula には、R1C1 と A1 型の区別がありません。また、わざわざ、R1C1 方式で数式を書く必要はありません。

お礼

何度もお手を煩わせてしまい誠に申し訳ございません。
そして貴重なアドバイスまでいただきまして、誠にありがとうございます。

うまく日付部分も理想的な形になりました。
現在、実用化に向けてテストを繰り返しているところです。
もしかしたら細かい点の仕様変更が出てくる可能性もありますが…。

約１週間後の7/11夜あたりにはテスト結果を書き込みできると思います。
お時間引っ張ってしまいまして誠に申し訳ございません。
どうぞ宜しくお願い致します。

あらためまして、ここまでのお力添え、心よりお礼申し上げます。

補足

長らくお時間かかってしまい申し訳ございませんでした。
テストのほうも特に想定外な問題も無く順調でございます。
ありがとうございます。

ところで・・・
度々で誠に恐縮でございますが、最後に１つだけお聞きしたいのですが、
例えば、送付する総数量169、1箱の最大入り数50だった場合、
現状では、加工後シートの箱内数量は、
50
50
50
19

となるわけですが、
例えば下記のように、端数を先頭へ持ってくることは可能でしょうか・・？

19
50
50
50

何度も何度も本当に申し訳ございません！！
どうか宜しくお願い致します。

Sub ボタン1_Click()
With Sheets("加工後")
.Range("2:65536").ClearContents
If IsDate(Range("I3").Value) Then
BoxNo = Format(Range("I3").Value, "yyyymmdd")
Else
MsgBox "日付がありません。", 48: Exit Sub
End If
For i = 2 To Range("A65536").End(xlUp).Row
For j = 1 To Range("D" & i).Value
GYOU = .Range("A65536").End(xlUp).Row + 1
.Range("A" & GYOU).Value = Range("A" & i).Value
.Range("B" & GYOU).Value = Range("B" & i).Value
.Range("C" & GYOU).Value = Range("C" & i).Value
.Range("D" & GYOU).Value = Range("D" & i).Value
.Range("E" & GYOU).Value = j
.Range("F" & GYOU).Value = Range("F" & i).Value
.Range("G" & GYOU).NumberFormat = "00000"
.Range("G" & GYOU).Value = BoxNo & Format$(GYOU - 1, "00000")
.Range("H" & GYOU).FormulaR1C1 = _
"=MIN(RC[-5],RC[-6]-SUMIF(R1C[-2]:R[-1]C[-2],RC[-2],R1C[-5]:R[-1]C[-5]))"
Next j
Next i
End With
End Sub

回答No.3

Wendy02

>両方ご教示下さいますと誠にありがたく存じます。
申し訳ありませんが、一応、自分も作ったものには、それなりの考えを持って作られたものですが、他の方と同じラインに並べるということは出来ませんので私のコードは、そのままにさせます。私は、すでに、その部分は、想定済みです。
>nBox = 0 '箱固有番号_初期値　ここを書き換えるだけで済むわけです。

元のコード。

.UsedRange.Offset(1).ClearContents
BoxNo = Format(Date, "yyyymmdd")　　'←この行を入れる

-----
前　.Range("G" & GYOU).Value = GYOU - 1
　　　　　↓
.Range("G" & GYOU).NumberFormat = "00000" '←この行を入れる
.Range("G" & GYOU).Value = BoxNo & Format$(GYOU - 1, "00000") '上記と書き換え

お礼

お礼が遅くなりまして誠に申し訳ございません。
ご教示いただきましたアドバイスを元に下記のように訂正してみました。

Sub ボタン1_Click()
With Sheets("加工後")
.Range("2:65536").ClearContents
BoxNo = Format(Date, "yyyymmdd")
For i = 2 To Range("A65536").End(xlUp).Row
For j = 1 To Range("D" & i).Value
GYOU = .Range("A65536").End(xlUp).Row + 1
.Range("A" & GYOU).Value = Range("A" & i).Value
.Range("B" & GYOU).Value = Range("B" & i).Value
.Range("C" & GYOU).Value = Range("C" & i).Value
.Range("D" & GYOU).Value = Range("D" & i).Value
.Range("E" & GYOU).Value = j
.Range("F" & GYOU).Value = Range("F" & i).Value
.Range("G" & GYOU).NumberFormat = "00000"
.Range("G" & GYOU).Value = BoxNo & Format$(GYOU - 1, "00000")
.Range("H" & GYOU).FormulaR1C1 = _
"=MIN(RC[-5],RC[-6]-SUMIF(R1C[-2]:R[-1]C[-2],RC[-2],R1C[-5]:R[-1]C[-5]))"
Next j
Next i
End With
End Sub

この形であれば確かに、「日付＋5桁の連番」になるのですが、本日の日付限定になってしまいます。
本日の日付の場合もあるのですが、それ以外の日付の場合も想定したいので、
出来れば、5桁の連番の前に入る日付部分は、加工前シートで手入力したものがそのまま反映出来ると非常に理想的です。

あれもこれも聞いてばかりでは本当に申し訳ないので私なりにも試行錯誤しながら考えてるのですが、
おそらく、
BoxNo = Format(Date, "yyyymmdd")
の部分を訂正すれば良いのではないかという所まではなんとなく分かるのですが、
BoxNo = Format(00000000) としてみたり、
BoxNo = Format("00000000")　としてみたり、
BoxNo = (00000000) としてみたり、
BoxNo = ("00000000")　としてみたり、
思いつく限りを色々試してみたのですがダメでした・・。

誠にお恥ずかしい限りではございますが、どうかご教示いただけませんでしょうか？
何度もお手数をおかけ致しまして、本当に申し訳ございません・・。
どうか宜しくお願い致します。

回答No.2

Wendy02

>'// ・・・・End Sub　までをVBAに貼り付けても、マクロ名の所に出てこないので、

Private Sub CommandButton1_Click()　'←これは、コントロールツールのボタン用です。
　　　↓
Sub ボタン1_Click()

と書き換えてください。(もちろん、標準モジュールだと思います）

お礼

ありがとうございます。
そういうことだったんですね！
おかげ様でどちらのVBAでも動くようになりました。
ほんとに感謝の気持ちでいっぱいです。
ありがとうございます。

ところで実は仕様変更がありまして、
「箱固有番号」の列なのですが、
当初は１からの連番でよかったのですが、
正式には、日付＋連番という形が理想で、
例えば今日の日付でしたら、
2010062600001
2010062600002
2010062600003
2010062600004
2010062600005
というようになります。

これが今のVBAだと、加工前シートで、「2010062600001」の形にしても、
加工後シートでは、
1
2
3
4
5
となってしまいます。

加工後シートでも、
2010062600001
　・
　・
2010062600005
というように同じ形にするには、
VBAのどこを修正すればよろしいでしょうか？

誠に恐縮で申し上げにくいことなのですが、
下記VBAの修正箇所と、
Wendy02様からご教示いただきましたVBAの修正箇所を
両方ご教示下さいますと誠にありがたく存じます。
誠に恐れ入りますが、どうか宜しくお願い申し上げます。

Sub ボタン1_Click()
With Sheets("加工後")
.Range("2:65536").ClearContents
For i = 2 To Range("A65536").End(xlUp).Row
For j = 1 To Range("D" & i).Value
GYOU = .Range("A65536").End(xlUp).Row + 1
.Range("A" & GYOU).Value = Range("A" & i).Value
.Range("B" & GYOU).Value = Range("B" & i).Value
.Range("C" & GYOU).Value = Range("C" & i).Value
.Range("D" & GYOU).Value = Range("D" & i).Value
.Range("E" & GYOU).Value = j
.Range("F" & GYOU).Value = Range("F" & i).Value
.Range("G" & GYOU).Value = GYOU - 1
.Range("H" & GYOU).FormulaR1C1 = _
"=MIN(RC[-5],RC[-6]-SUMIF(R1C[-2]:R[-1]C[-2],RC[-2],R1C[-5]:R[-1]C[-5]))"
Next j
Next i
End With
End Sub

回答No.1

Wendy02

>正常な結果を求めるには、どこを修正すればよろしいでしょうか？
そのまま使えば良かったはずです。計算だったら、i-1 の単なる足し算すれば良かったと思います。前の内容をきちんと読んでいませんので、事情が分かりません。果たして、4桁で足りているのかは分かりません。

ご質問のコードでしたら、以下のようにしたら良いはずです。
　.Range("F" & GYOU).Value = "111-1111-" & Right("1111" & (i - 1), 4)
　　　　↓
.Range("F" & GYOU).Value = Range("F" & i).Value

なお、私のスタイルは、他人のVBAをそのままにすることはしませんので、自分なりにコードを書いてみました。
私の場合は、ワークシート関数は使いません。

でも、転記後は、
加工前
送付する総数量　　　1箱の最大入り敷　　必要箱数
　　　　　　90　　　　　　　　50　　　　　　　　　　　　2

加工後
送付する総数量　　　1箱の最大入り敷　　必要箱数　　箱内数量
　　　　　　90　　　　　　　　50　　　　　　　　　　　2　　　　　　　50
　　　　　　　　　　　　　　　50　　　　　　　　　　　　　　　　　　　40

このように正規化したほうが分かりやすいかもしれません。

'//
Private Sub CommandButton1_Click()
　Dim sh As Worksheet
　Dim i As Long, k As Long, j As Long, m As Long, t As Long
　Dim LastR As Long
　Dim nBox As Long

　nBox = 0 '箱固有番号_初期値
　Set sh = Worksheets("加工後") '転記後のシート
　'転記シートのデータ削除
　sh.UsedRange.Offset(1).ClearContents
　k = 2　'転記後の書き出し行の初期値
　With sh
　　LastR = Cells(Rows.Count, 1).End(xlUp).Row
　　For i = 2 To LastR
　　　If Cells(i, 2).Value <= Cells(i, 3).Value Then
　　　　.Cells(k, 1).Resize(, 5).Value = Cells(i, 1).Resize(, 5).Value
　　　　.Cells(k, 6).Value = Cells(i, 6).Value
　　　　.Cells(k, 7).Value = nBox + k - 1
　　　　.Cells(k, 8).Value = Cells(i, 8).Value
　　　　k = k + 1
　　　Else
　　　　m = Cells(i, 4).Value
　　　　''m = Int(Cells(i, 2).Value / Cells(i, 3).Value) _
　　　　+ IIf(Cells(i, 2).Value Mod Cells(i, 3).Value, 1, 0)　'個数計算（省略）
　　　　t = Cells(i, 2).Value
　　　　For j = 1 To m
　　　　　.Cells(k, 1).Resize(, 4).Value = Cells(i, 1).Resize(, 4).Value
　　　　　If j <> m Then
　　　　　　.Cells(k, 8).Value = Cells(i, 3).Value
　　　　　Else
　　　　　　sh.Cells(k, 8).Value = t Mod Cells(i, 3).Value
　　　　　End If
　　　　　.Cells(k, 5).Value = j
　　　　　.Cells(k, 6).Value = Cells(i, 6).Value
　　　　　.Cells(k, 7).Value = nBox + k - 1
　　　　　k = k + 1
　　　　Next
　　 End If
　　Next
　End With
　'完了後の音
　Beep
End Sub

お礼

お礼が遅くなりまして誠に申し訳ございませんでした。
他にもいくつか問題が出てきてしまって試行錯誤しておりました・・・。

ご教示いただきました方法につきましても試しているのですが、
'// ・・・・End Sub　までをVBAに貼り付けても、マクロ名の所に出てこないので、
フォームのボタンに登録とかが出来ないのですが、何かやり方が違うでしょうか？