[[20110326225751]] 『同じ行数の入力と簡略化』（ゆん） ページの最後に飛ぶ
[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『同じ行数の入力と簡略化』（ゆん）
いつもお世話になっております。 以前、HANA様から頂いたマクロを、別目的にて自分で組み合わせてみたのですが、 どうもうまくいきません。宜しくお願い致します。
1．複数入力後、2つ目のWITH間のみがE列一番上の一行だけ の入力になってしまう。 (1つ目のWITH間では単数のみの入力しかありません）
2．動作が非常に重たいので、どうにかして同動作でコードの簡略化をしたいです。
Sub Macro6()
Application.ScreenUpdating = False
ActiveSheet.Unprotect
Range("Q6:AJ21").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("支払いシステム Ver1.7.1.xlsb").Activate
Sheets("オーダー").Select
Range("W56").Select
ActiveCell.FormulaR1C1 = "1"
Windows("Book1.xlsb").Activate
Dim MxR As Long, DtCount As Long
With Worksheets("データマスタ")
MxR = .Range("B" & Rows.Count).End(xlUp).Row 'With の中に移動。Rangeの前に.をつける
DtCount = Application.Count(Range("E$5:E$19")) 'Rangeの前の.を消す
.Range("B" & MxR + 1).Resize(DtCount).Value = Right(Year(Range("A1").Value), 2)
'左側は、Rangeの前に.をつける 右側は、Rangeの前の.を消す 以下同様に。
.Range("C" & MxR + 1).Resize(DtCount).Value = Month(Range("A1").Value)
.Range("D" & MxR + 1).Resize(DtCount).Value = Day(Range("A1").Value)
.Range("E" & MxR + 1).Resize(DtCount).Value = Range("AX3").Resize(DtCount).Value '2列分
.Range("F" & MxR + 1).Resize(DtCount).Value = Range("R8").Resize(DtCount).Value
.Range("G" & MxR + 1).Resize(DtCount).Value = Range("AC11").Resize(DtCount).Value
.Range("H" & MxR + 1).Resize(DtCount).Value = Range("AC3").Value
.Range("I" & MxR + 1).Resize(DtCount).Value = Range("T8").Resize(DtCount).Value
.Range("P" & MxR + 1).Resize(DtCount).Value = Range("R20").Value
.Range("AL" & MxR + 1).Resize(DtCount).Formula = _
"=IF(RC[-32]=0,0,IF(ISERROR(VLOOKUP(RC[-32],商品マスタT!R3C1:R171C4,3,FALSE))" _
& ",control!R7C2,VLOOKUP(RC[-32],商品マスタT!R3C1:R171C4,3,FALSE)))"
.Range("Q" & MxR + 1).Resize(DtCount).Formula = _
"=IF(RC[-1]=""10% de Descuento!!"",RC[21]*0.9,IF(RC[-1]=""5% de Descuento!!""" _
& ",RC[21]*0.95,IF(RC[-1]=""5% de Descuento!!"",RC[21]*0.95)*FALSE))"
.Range("Q" & MxR + 1).Resize(DtCount).Value = .Range("Q" & MxR + 1).Resize(DtCount).Value
.Range("J" & MxR + 1).Resize(DtCount).Formula = _
"=IF(RC[7]>0,RC[7],IF(RC[-4]=0,0,IF(ISERROR(VLOOKUP(RC[-4],商品マスタT!R3C1:R171C4,3,FALSE))" _
& ",control!R7C2,VLOOKUP(RC[-4],商品マスタT!R3C1:R171C4,3,FALSE))))"
.Range("J" & MxR + 1).Resize(DtCount).Value = .Range("J" & MxR + 1).Resize(DtCount).Value
.Range("K" & MxR + 1).Resize(DtCount).Formula = _
"=IF(RC[-5]=0,0,IF(ISERROR(VLOOKUP(RC[-5],商品マスタT!R3C1:R171C4,4,FALSE))" _
& ",control!R7C2,VLOOKUP(RC[-5],商品マスタT!R3C1:R171C4,4,FALSE)))"
.Range("K" & MxR + 1).Resize(DtCount).Value = .Range("K" & MxR + 1).Resize(DtCount).Value
.Range("L" & MxR + 1).Resize(DtCount).Formula = _
"=IF(ISERROR(RC[-5]*RC[-2]),0,RC[-5]*RC[-2])"
.Range("L" & MxR + 1).Resize(DtCount).Value = .Range("L" & MxR + 1).Resize(DtCount).Value
.Range("M" & MxR + 1).Resize(DtCount).Formula = _
"=IF(ISERROR(RC[-6]*RC[-2]),0,RC[-6]*RC[-2])"
.Range("M" & MxR + 1).Resize(DtCount).Value = .Range("M" & MxR + 1).Resize(DtCount).Value
.Range("N" & MxR + 1).Resize(DtCount).Formula = _
"=IF(ISERROR(RC[-2]-RC[-1]),0,RC[-2]-RC[-1])"
.Range("N" & MxR + 1).Resize(DtCount).Value = .Range("N" & MxR + 1).Resize(DtCount).Value
.Range("O" & MxR + 1).Resize(DtCount).Formula = _
"=IF(ISERROR(RC[-1]/RC[-3]),0,RC[-1]/RC[-3])"
.Range("O" & MxR + 1).Resize(DtCount).Value = .Range("O" & MxR + 1).Resize(DtCount).Value
.Range("AL" & MxR + 1).Resize(DtCount).ClearContents
.Range("AK" & MxR + 1).Resize(DtCount).ClearContents
End With
With Worksheets("データマスタ")
MxR = .Range("B" & Rows.Count).End(xlUp).Row 'With の中に移動。Rangeの前に.をつける
DtCount = Application.Count(Range("N$4:N$38")) 'Rangeの前の.を消す
.Range("B" & MxR + 1).Resize(DtCount).Value = Right(Year(Range("A1").Value), 2)
'左側は、Rangeの前に.をつける 右側は、Rangeの前の.を消す 以下同様に。
.Range("C" & MxR + 1).Resize(DtCount).Value = Month(Range("A1").Value)
.Range("D" & MxR + 1).Resize(DtCount).Value = Day(Range("A1").Value)
.Range("E" & MxR + 1).Resize(DtCount).Value = Range("AX3").Resize(DtCount).Value '2列分
.Range("F" & MxR + 1).Resize(DtCount).Value = Range("R11").Resize(DtCount).Value
.Range("G" & MxR + 1).Resize(DtCount).Value = Range("AC11").Resize(DtCount).Value
.Range("H" & MxR + 1).Resize(DtCount).Value = Range("AC3").Value
.Range("I" & MxR + 1).Resize(DtCount).Value = Range("T11").Resize(DtCount).Value
.Range("P" & MxR + 1).Resize(DtCount).Value = Range("R20").Value
.Range("AL" & MxR + 1).Resize(DtCount).Formula = _
"=IF(RC[-32]=0,0,IF(ISERROR(VLOOKUP(RC[-32],商品マスタT!R3C1:R171C4,3,FALSE))" _
& ",control!R7C2,VLOOKUP(RC[-32],商品マスタT!R3C1:R171C4,3,FALSE)))"
.Range("Q" & MxR + 1).Resize(DtCount).Formula = _
"=IF(RC[-1]=""10% de Descuento!!"",RC[21]*0.9,IF(RC[-1]=""5% de Descuento!!""" _
& ",RC[21]*0.95,IF(RC[-1]=""5% de Descuento!!"",RC[21]*0.95)*FALSE))"
.Range("Q" & MxR + 1).Resize(DtCount).Value = .Range("Q" & MxR + 1).Resize(DtCount).Value
.Range("J" & MxR + 1).Resize(DtCount).Formula = _
"=IF(RC[7]>0,RC[7],IF(RC[-4]=0,0,IF(ISERROR(VLOOKUP(RC[-4],商品マスタT!R3C1:R171C4,3,FALSE))" _
& ",control!R7C2,VLOOKUP(RC[-4],商品マスタT!R3C1:R171C4,3,FALSE))))"
.Range("J" & MxR + 1).Resize(DtCount).Value = .Range("J" & MxR + 1).Resize(DtCount).Value
.Range("K" & MxR + 1).Resize(DtCount).Formula = _
"=IF(RC[-5]=0,0,IF(ISERROR(VLOOKUP(RC[-5],商品マスタT!R3C1:R171C4,4,FALSE))" _
& ",control!R7C2,VLOOKUP(RC[-5],商品マスタT!R3C1:R171C4,4,FALSE)))"
.Range("K" & MxR + 1).Resize(DtCount).Value = .Range("K" & MxR + 1).Resize(DtCount).Value
.Range("L" & MxR + 1).Resize(DtCount).Formula = _
"=IF(ISERROR(RC[-5]*RC[-2]),0,RC[-5]*RC[-2])"
.Range("L" & MxR + 1).Resize(DtCount).Value = .Range("L" & MxR + 1).Resize(DtCount).Value
.Range("M" & MxR + 1).Resize(DtCount).Formula = _
"=IF(ISERROR(RC[-6]*RC[-2]),0,RC[-6]*RC[-2])"
.Range("M" & MxR + 1).Resize(DtCount).Value = .Range("M" & MxR + 1).Resize(DtCount).Value
.Range("N" & MxR + 1).Resize(DtCount).Formula = _
"=IF(ISERROR(RC[-2]-RC[-1]),0,RC[-2]-RC[-1])"
.Range("N" & MxR + 1).Resize(DtCount).Value = .Range("N" & MxR + 1).Resize(DtCount).Value
.Range("O" & MxR + 1).Resize(DtCount).Formula = _
"=IF(ISERROR(RC[-1]/RC[-3]),0,RC[-1]/RC[-3])"
.Range("O" & MxR + 1).Resize(DtCount).Value = .Range("O" & MxR + 1).Resize(DtCount).Value
.Range("AL" & MxR + 1).Resize(DtCount).ClearContents
.Range("AK" & MxR + 1).Resize(DtCount).ClearContents
End With
Range("E5:E19,N4:N38").ClearContents
ActiveSheet.Protect
Application.ScreenUpdating = True
End Sub
HANAさんからコメントがあるとは思いますが、２ に関して感想だけ。
特に無駄な処理があるわけでもなさそうなので、現状の処理速度が必ずしも 悪いというわけではないようです。 処理の時間はコードの量ではなく、処理するコードのステップとそれぞれの行 の実行時間の累積によって決まります。 今回のコードに冗長な部分があるわけでもないので、下手げにいじるよりは 現状のままの方がよいのではないでしょうか。
速度を早くしようとすると、式を使う処理をやめてコードで計算して値を直接 書くことにより改善は期待できますが、コード量は今の倍以上になると思います。 (Mook)
Mookさん、お世話になります。
ゆんさん、お久しぶりです。
(1)の方の質問に関しては 何の事をおっしゃっているのかわかりません。
コードを載せるだけではなく、 どのようなサンプルデータがあるのか。 このコードはどの様な事をするのか。 実行結果はどうなって欲しいのか。 実際の結果は希望に反してどうなるのか。 面倒でも、説明が必要だと思いますよ。
(2)の方は、どこが重いのですか？ 最初の（Q6:AJ21をコピーして値貼り付けの）部分でしょうか？ 次に続く、計算式を入力していく部分でしょうか？
それぞれ部分をバラバラにして 検証してみてください。
シート（ブック）に関する説明が全くないですので こちらでは、何がどのようになっているのかよくわかりません。
また、コードだけを載せてあるので、「そのコードで何をしているのか」 よくわかりません。
もしも、数式が大量に埋め込まれていて マクロが内容を変更する範囲のセルを参照していたら 再計算に時間がかかって、全体の処理速度が落ちているかもしれません。
これに関しては、いったん計算方法を手動にして実行した時 （結果はもちろん 違った値が表示されますが） すぐに終わるかどうかで 簡単な確認ができるのではないかと思います。
(HANA)
Mook様初めまして、HANA様、覚えていて頂き光栄です、ご無沙汰しております。
説明不足で申し訳ありません。以下に各BOOK、SHEETの詳細を書きます。
BOOK1>SHEET1 ---------------------------
B C D E F … I L M N O … R T AC AF
3 コード 商品名 単価 数量 合計金額
4 コード 商品名 単価 数量 合計金額
5
6
7
8
9
10
11
…
38
BOOK1で手動入力する部分は数量のE3:E19までと、同じく数量のN4:N38までです。 解り易くピザで例えさせていただきますが、左側のB3:F19までのC列には「生地」の 種類、例えば「軟らかめの生地」、「カリカリの生地」などの媒体となる商品が書い てあり、E3:E19に数字を入力すると同シート上のR8にコード、T8に商品名、AC8に数量、 AF8に金額が出力されるようになっています。
右側のH3:O38には上記のピザに乗せる「具」（サラミやアンチョビ等）がL列に商品とし て書いてあります。N4:N38に数字を入力すると同シート上のR11にコード、T11に商 品名、AC11に数量、AF11に金額に出力されます。
上記を動かすためのコードが、
Range("R8:R9").FormulaR1C1 = _
"=IFERROR(INDEX(C[-16],SMALL(INDEX((R3C[-13]:R19C[-13]=0)*32^4+ROW(R3C[-17]:R19C[-17]),0),ROW(R[-7]C[-16]))),"""")"
Range("T8:AA9").FormulaR1C1 = _
"=IF(RC[-2]="""","""",IF(ISNA(VLOOKUP(RC[-2],R5C2:R19C6,2,FALSE)),""未登録"",VLOOKUP(RC[-2],R5C2:R19C6,2,FALSE)))"
Range("AC8:AC9").FormulaR1C1 = _
"=IF(RC[-11]="""","""",IF(ISNA(VLOOKUP(RC[-11],R5C2:R19C6,4,FALSE)),""未登録"",VLOOKUP(RC[-11],R5C2:R19C6,4,FALSE)))"
Range("AF8:AH9").FormulaR1C1 = _
"=IF(RC[-14]="""","""",IF(ISNA(VLOOKUP(RC[-14],R5C2:R19C6,5,FALSE)),""未登録"",VLOOKUP(RC[-14],R5C2:R19C6,5,FALSE)))"
Range("R11").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(INDEX(C[-9],SMALL(INDEX((R3C[-4]:R38C[-4]=0)*32^4+ROW(R3C[-17]:R38C[-17]),0),ROW(R[-10]C[-9]))),"""")"
Selection.AutoFill Destination:=Range("R11:R18"), Type:=xlFillDefault
Range("T11:AA11").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-2]="""","""",IF(ISNA(VLOOKUP(RC[-2],R4C9:R38C15,4,FALSE)),""未登録"",VLOOKUP(RC[-2],R4C9:R38C15,4,FALSE)))"
Selection.AutoFill Destination:=Range("T11:AA18"), Type:=xlFillDefault
Range("AC11").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-11]="""","""",IF(ISNA(VLOOKUP(RC[-11],R4C9:R38C15,6,FALSE)),""未登録"",VLOOKUP(RC[-11],R4C9:R38C15,6,FALSE)))"
Selection.AutoFill Destination:=Range("AC11:AC18"), Type:=xlFillDefault
Range("AF11:AH11").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-14]="""","""",IF(ISNA(VLOOKUP(RC[-14],R4C9:R38C15,7,FALSE)),""未登録"",VLOOKUP(RC[-14],R4C9:R38C15,7,FALSE)))"
Selection.AutoFill Destination:=Range("AF11:AH18"), Type:=xlFillDefault
Range("AC20:AH20").FormulaR1C1 = "=SUM(R[-12]C[3]:R[-1]C[5])"
BOOK1>データマスタ --------------------------------------
A E F G H I … P Q AK AL
2 コードNo. 顧客番号 商品番号 数量 得意先名 商品名 … 備考 修正単価 単価計算 商品値段
.
5 1 1 1 1 山田太郎 米10kg … 10%割 460 460 500
6 2 15 122 6 山田花子 鰹節 … 割引無 200 200 200
.
.
100002
上記のSHEET1からの情報をこのシートに出力させるのに少々手間取っております。 顧客番号E列だけが複数行の入力があっても一行だけしか入力されません。この一行 だけしか入力されない、ってのを手動フィルにて妥協すれば概ね希望道りの動きを しますが、動作が重いってのは流石に妥協（我慢）できず。。。Withを一つにする など色々やりましたが、どうもうまく動いてくれません。
解決策があるならば、是非ご教授下さい。
↓このマクロは、BOOK1>SHEET1のマクロです
Application.ScreenUpdating = False
ActiveSheet.Unprotect
Windows("支払いシステム Ver1.7.1.xlsb").Activate
Sheets("オーダー").Select
Range("W56").Select
ActiveCell.FormulaR1C1 = "1"
Windows("Book1.xlsb").Activate
Dim MxR As Long, DtCount As Long
With Worksheets("データマスタ")
MxR = .Range("B" & Rows.Count).End(xlUp).Row 'With の中に移動。Rangeの前に.をつける
DtCount = Application.Count(Range("E$5:E$19")) 'Rangeの前の.を消す
.Range("B" & MxR + 1).Resize(DtCount).Value = Right(Year(Range("A1").Value), 2)
'左側は、Rangeの前に.をつける 右側は、Rangeの前の.を消す 以下同様に。
.Range("C" & MxR + 1).Resize(DtCount).Value = Month(Range("A1").Value)
.Range("D" & MxR + 1).Resize(DtCount).Value = Day(Range("A1").Value)
.Range("E" & MxR + 1).Resize(DtCount).Value = Range("AX3").Resize(DtCount).Value '2列分
.Range("F" & MxR + 1).Resize(DtCount).Value = Range("R8").Resize(DtCount).Value
.Range("G" & MxR + 1).Resize(DtCount).Value = Range("AC11").Resize(DtCount).Value
.Range("H" & MxR + 1).Resize(DtCount).Value = Range("AC3").Value
.Range("I" & MxR + 1).Resize(DtCount).Value = Range("T8").Resize(DtCount).Value
.Range("P" & MxR + 1).Resize(DtCount).Value = Range("R20").Value
.Range("AL" & MxR + 1).Resize(DtCount).Formula = _
"=IF(RC[-32]=0,0,IF(ISERROR(VLOOKUP(RC[-32],商品マスタT!R3C1:R65C4,3,FALSE))" _
& ",control!R7C2,VLOOKUP(RC[-32],商品マスタT!R3C1:R65C4,3,FALSE)))"
.Range("Q" & MxR + 1).Resize(DtCount).Formula = _
"=IF(RC[-1]=""10% de Descuento!!"",RC[21]*0.9,IF(RC[-1]=""5% de Descuento!!""" _
& ",RC[21]*0.95,IF(RC[-1]=""5% de Descuento!!"",RC[21]*0.95)*FALSE))"
.Range("Q" & MxR + 1).Resize(DtCount).Value = .Range("Q" & MxR + 1).Resize(DtCount).Value
.Range("J" & MxR + 1).Resize(DtCount).Formula = _
"=IF(RC[7]>0,RC[7],IF(RC[-4]=0,0,IF(ISERROR(VLOOKUP(RC[-4],商品マスタT!R3C1:R65C4,3,FALSE))" _
& ",control!R7C2,VLOOKUP(RC[-4],商品マスタT!R3C1:R65C4,3,FALSE))))"
.Range("J" & MxR + 1).Resize(DtCount).Value = .Range("J" & MxR + 1).Resize(DtCount).Value
.Range("K" & MxR + 1).Resize(DtCount).Formula = _
"=IF(RC[-5]=0,0,IF(ISERROR(VLOOKUP(RC[-5],商品マスタT!R3C1:R65C4,4,FALSE))" _
& ",control!R7C2,VLOOKUP(RC[-5],商品マスタT!R3C1:R65C4,4,FALSE)))"
.Range("K" & MxR + 1).Resize(DtCount).Value = .Range("K" & MxR + 1).Resize(DtCount).Value
.Range("L" & MxR + 1).Resize(DtCount).Formula = _
"=IF(ISERROR(RC[-5]*RC[-2]),0,RC[-5]*RC[-2])"
.Range("L" & MxR + 1).Resize(DtCount).Value = .Range("L" & MxR + 1).Resize(DtCount).Value
.Range("M" & MxR + 1).Resize(DtCount).Formula = _
"=IF(ISERROR(RC[-6]*RC[-2]),0,RC[-6]*RC[-2])"
.Range("M" & MxR + 1).Resize(DtCount).Value = .Range("M" & MxR + 1).Resize(DtCount).Value
.Range("N" & MxR + 1).Resize(DtCount).Formula = _
"=IF(ISERROR(RC[-2]-RC[-1]),0,RC[-2]-RC[-1])"
.Range("N" & MxR + 1).Resize(DtCount).Value = .Range("N" & MxR + 1).Resize(DtCount).Value
.Range("O" & MxR + 1).Resize(DtCount).Formula = _
"=IF(ISERROR(RC[-1]/RC[-3]),0,RC[-1]/RC[-3])"
.Range("O" & MxR + 1).Resize(DtCount).Value = .Range("O" & MxR + 1).Resize(DtCount).Value
.Range("AL" & MxR + 1).Resize(DtCount).ClearContents
.Range("AK" & MxR + 1).Resize(DtCount).ClearContents
End With
With Worksheets("データマスタ")
MxR = .Range("B" & Rows.Count).End(xlUp).Row 'With の中に移動。Rangeの前に.をつける
DtCount = Application.Count(Range("N$4:N$38")) 'Rangeの前の.を消す
.Range("B" & MxR + 1).Resize(DtCount).Value = Right(Year(Range("A1").Value), 2)
'左側は、Rangeの前に.をつける 右側は、Rangeの前の.を消す 以下同様に。
.Range("C" & MxR + 1).Resize(DtCount).Value = Month(Range("A1").Value)
.Range("D" & MxR + 1).Resize(DtCount).Value = Day(Range("A1").Value)
.Range("E" & MxR + 1).Resize(DtCount).Value = Range("AX3").Resize(DtCount).Value '2列分
.Range("F" & MxR + 1).Resize(DtCount).Value = Range("R11").Resize(DtCount).Value
.Range("G" & MxR + 1).Resize(DtCount).Value = Range("AC11").Resize(DtCount).Value
.Range("H" & MxR + 1).Resize(DtCount).Value = Range("AC3").Value
.Range("I" & MxR + 1).Resize(DtCount).Value = Range("T11").Resize(DtCount).Value
.Range("P" & MxR + 1).Resize(DtCount).Value = Range("R20").Value
.Range("AL" & MxR + 1).Resize(DtCount).Formula = _
"=IF(RC[-32]=0,0,IF(ISERROR(VLOOKUP(RC[-32],商品マスタT!R3C1:R65C4,3,FALSE))" _
& ",control!R7C2,VLOOKUP(RC[-32],商品マスタT!R3C1:R65C4,3,FALSE)))"
.Range("Q" & MxR + 1).Resize(DtCount).Formula = _
"=IF(RC[-1]=""10% de Descuento!!"",RC[21]*0.9,IF(RC[-1]=""5% de Descuento!!""" _
& ",RC[21]*0.95,IF(RC[-1]=""5% de Descuento!!"",RC[21]*0.95)*FALSE))"
.Range("Q" & MxR + 1).Resize(DtCount).Value = .Range("Q" & MxR + 1).Resize(DtCount).Value
.Range("J" & MxR + 1).Resize(DtCount).Formula = _
"=IF(RC[7]>0,RC[7],IF(RC[-4]=0,0,IF(ISERROR(VLOOKUP(RC[-4],商品マスタT!R3C1:R65C4,3,FALSE))" _
& ",control!R7C2,VLOOKUP(RC[-4],商品マスタT!R3C1:R65C4,3,FALSE))))"
.Range("J" & MxR + 1).Resize(DtCount).Value = .Range("J" & MxR + 1).Resize(DtCount).Value
.Range("K" & MxR + 1).Resize(DtCount).Formula = _
"=IF(RC[-5]=0,0,IF(ISERROR(VLOOKUP(RC[-5],商品マスタT!R3C1:R65C4,4,FALSE))" _
& ",control!R7C2,VLOOKUP(RC[-5],商品マスタT!R3C1:R65C4,4,FALSE)))"
.Range("K" & MxR + 1).Resize(DtCount).Value = .Range("K" & MxR + 1).Resize(DtCount).Value
.Range("L" & MxR + 1).Resize(DtCount).Formula = _
"=IF(ISERROR(RC[-5]*RC[-2]),0,RC[-5]*RC[-2])"
.Range("L" & MxR + 1).Resize(DtCount).Value = .Range("L" & MxR + 1).Resize(DtCount).Value
.Range("M" & MxR + 1).Resize(DtCount).Formula = _
"=IF(ISERROR(RC[-6]*RC[-2]),0,RC[-6]*RC[-2])"
.Range("M" & MxR + 1).Resize(DtCount).Value = .Range("M" & MxR + 1).Resize(DtCount).Value
.Range("N" & MxR + 1).Resize(DtCount).Formula = _
"=IF(ISERROR(RC[-2]-RC[-1]),0,RC[-2]-RC[-1])"
.Range("N" & MxR + 1).Resize(DtCount).Value = .Range("N" & MxR + 1).Resize(DtCount).Value
.Range("O" & MxR + 1).Resize(DtCount).Formula = _
"=IF(ISERROR(RC[-1]/RC[-3]),0,RC[-1]/RC[-3])"
.Range("O" & MxR + 1).Resize(DtCount).Value = .Range("O" & MxR + 1).Resize(DtCount).Value
.Range("AL" & MxR + 1).Resize(DtCount).ClearContents
.Range("AK" & MxR + 1).Resize(DtCount).ClearContents
End With
Range("E5:E19,N4:N38").ClearContents
ActiveSheet.Protect
Application.ScreenUpdating = True
支払いシステムVer1.7.1 > オーダー -----------------------
C F W Z AA
4 コード 商品名 数量 金額 合計金額
5
6
7
…
177
別BOOKのにてBOOK1と2つのEXCELを開き、別々に管理しております。このBOOKにもF列に 商品名が入力されていて、ここにはBOOK1とは別のピザでは無い商品が入力されていま す。このオーダーシートのC56:W56にBOOK1で作成した商品がW56、Z56セルに反映され るようになっています。C56:F56のコード、商品名は固定です。
長くなりましたが、宜しくお願い致します。
（ゆん）
だいぶ分かって来たような気がします。 まだ、分からない所がたくさん有って、その部分は色々質問する事に成ると思います。 重複してお伺いする事が有ると思いますが、気長に教えて下さい。。。
(2)の動作が重い事を先にクリアして行きたいと思いますが (1)の方の質問がそれに関係しているのかどうかよく分かりません。
(1)の方の問題がある現在でも、コードは重いですか？
でしたら、以下の二つを確認してみて貰いたいです。
★１．どの部分で時間がかかっているのか 検証してみてください。
現在コードは大きく４つの部分に分かれていると思います。
◇１．Unprotect 〜 Windows("Book1.xlsb").Activate
◇２．With Worksheets("データマスタ") − DtCount = Application.Count(Range("E$5:E$19"))− End With
◇３．With Worksheets("データマスタ") − DtCount = Application.Count(Range("N$4:N$38"))− End With
◇４．ClearContents 〜 Protect
独立させて（Sub ○○ ・・・ End Sub ４つにわける） それぞれ順番に実行して貰っても良いですが。。。。 ブレークポイントの設定を やってみて貰うのが良いかもしれません。
例えば
コードが書いてある白い部分の左側に 灰色の部分が有ります。
その部分をクリックすると、茶色い●が表示されます。
コードを実行すると、一旦その部分で止まります。
再度「●」まで実行したい場合は、[F5]を押すか
ツールバーの「■」の二つ左隣りにある「三角」を押して下さい。
（↑の画像では 書式(O) の下に位置している「三角」です）
With Worksheets("データマスタ") の行2ヶ所と
Range("E5:E19,N4:N38").ClearContents の行1ヶ所の
計3ヶ所に「●」を付けて 実行してみて下さい。
どの部分で時間がかかっていますか？
★２．いったん計算方法を手動にして実行した時すぐに終わるかどうか 計算方法の切替手順はこちらをご参考に。 https://www.excel.studio-kazu.jp/tips/0037/ よくある質問『再計算してくれません』
(HANA)
HANA様、御返事有難うございます。
★1
言われた通りWITHの2か所、Range("E5:E19,N4:N38").ClearContentsに●をつけて実行してみました。
結果、WITH2か所で2か所とも約1.5秒ほどづつ時間が掛っているようです。それぞれ独立させてSub End
Subで試しても結果は同じでした。
>>(1)の方の問題がある現在でも、コードは重いですか？
はい、重いです。が、支払いシステムVer1.7.1を起動させていない場合、少しだけ体感速度が速くなり ます。ハード側の問題ですかね。。。だとしたら、お手上げです。Win Vista CORE2DUO 7250 Excel2007
★2 計算方法を手動にした場合、動作は速くなりましたが、R11:AF18には全て一番上に入力されている ものと同じコード、商品名、数量、値段が入ってしまいます。自動計算の場合は正しく入力されます。
（ゆん）
＞計算方法を手動にした場合、動作は速くなりました これに希望を託してみましょう。
一つ目の With 〜 の前に Application.Calculation = xlManual を入れて下さい。
これが、計算方法を手動にする命令文です。 マクロの記録で コードを取得する事が出来ます。
その後、計算式を値化する ○○.Value = ○○.Value は取り敢えず 一番下（End Withの前のClearContentsの前）にかためて さらに、纏められる部分は 纏めます。
例えば、一つ目の Wiht 〜 End With に関しては
.Range("Q" & MxR + 1).Resize(DtCount).Value = .Range("Q" & MxR + 1).Resize(DtCount).Value
.Range("J" & MxR + 1).Resize(DtCount).Value = .Range("J" & MxR + 1).Resize(DtCount).Value
.Range("K" & MxR + 1).Resize(DtCount).Value = .Range("K" & MxR + 1).Resize(DtCount).Value
.Range("L" & MxR + 1).Resize(DtCount).Value = .Range("L" & MxR + 1).Resize(DtCount).Value
.Range("M" & MxR + 1).Resize(DtCount).Value = .Range("M" & MxR + 1).Resize(DtCount).Value
.Range("N" & MxR + 1).Resize(DtCount).Value = .Range("N" & MxR + 1).Resize(DtCount).Value
.Range("O" & MxR + 1).Resize(DtCount).Value = .Range("O" & MxR + 1).Resize(DtCount).Value
が下に固まって来ますが、結局 J:O と Q列を値化しています。
P列が抜けていますが、ここは元から値が入っているので
.Range("J" & MxR + 1).Resize(DtCount, 8).Value = .Range("J" & MxR + 1).Resize(DtCount, 8).Value
の１行にして下さい。
(J列 mxr+1行)のセルから、 DtCount行と８列分(Q列迄）の範囲 を 値にします。
例えば、mxr が「3」で、DtCount が「5」だった場合 J4:Q8の範囲が 値化される事に成ります。
因みに、値化する前に 再計算して下さい。
With Worksheets("データマスタ") の中に入れるので
.Calculate
これで、データマスタシートのみ再計算されます。
また
.Range("AL" & MxR + 1).Resize(DtCount).ClearContents
.Range("AK" & MxR + 1).Resize(DtCount).ClearContents
これも、AK列とAL列は隣り同士なので、Resizeの列で指定して 一行にして仕舞いましょう。
.Range("AK" & MxR + 1).Resize(DtCount, 2).ClearContents
二つの With 〜 End With が終わったら、計算方法を自動にもどします。
簡単ではありますが、イメージを書いておきます。
'------
Sub Test_計算方法手動切替()
'◇１ はそのまま
'・・・・・・
'★追加：計算方法を手動に
Application.Calculation = xlManual
'◇２
With Worksheets("データマスタ")
'↓ここは一緒
MxR = .Range("B" & Rows.Count).End(xlUp).Row
DtCount = Application.Count(Range("E$5:E$19"))
'↓ここは一緒
.Range("B" & MxR + 1).Resize(DtCount).Value = Right(Year(Range("A1").Value), 2)
.Range("C" & MxR + 1).Resize(DtCount).Value = Month(Range("A1").Value)
.Range("D" & MxR + 1).Resize(DtCount).Value = Day(Range("A1").Value)
'↓ここは一緒
.Range("E" & MxR + 1).Resize(DtCount).Value = Range("AX3").Resize(DtCount).Value
.Range("F" & MxR + 1).Resize(DtCount).Value = Range("R8").Resize(DtCount).Value
.Range("G" & MxR + 1).Resize(DtCount).Value = Range("AC11").Resize(DtCount).Value
.Range("H" & MxR + 1).Resize(DtCount).Value = Range("AC3").Value
.Range("I" & MxR + 1).Resize(DtCount).Value = Range("T8").Resize(DtCount).Value
.Range("P" & MxR + 1).Resize(DtCount).Value = Range("R20").Value
'↓先に式をどんどん入れる
.Range("AL" & MxR + 1).Resize(DtCount).Formula = _
"=IF(RC[-32]=0,0,IF(ISERROR(VLOOKUP(RC[-32],商品マスタT!R3C1:R65C4,3,FALSE))" _
& ",control!R7C2,VLOOKUP(RC[-32],商品マスタT!R3C1:R65C4,3,FALSE)))"
.Range("Q" & MxR + 1).Resize(DtCount).Formula = _
"=IF(RC[-1]=""10% de Descuento!!"",RC[21]*0.9,IF(RC[-1]=""5% de Descuento!!""" _
& ",RC[21]*0.95,IF(RC[-1]=""5% de Descuento!!"",RC[21]*0.95)*FALSE))"
.Range("J" & MxR + 1).Resize(DtCount).Formula = _
"=IF(RC[7]>0,RC[7],IF(RC[-4]=0,0,IF(ISERROR(VLOOKUP(RC[-4],商品マスタT!R3C1:R65C4,3,FALSE))" _
& ",control!R7C2,VLOOKUP(RC[-4],商品マスタT!R3C1:R65C4,3,FALSE))))"
.Range("K" & MxR + 1).Resize(DtCount).Formula = _
"=IF(RC[-5]=0,0,IF(ISERROR(VLOOKUP(RC[-5],商品マスタT!R3C1:R65C4,4,FALSE))" _
& ",control!R7C2,VLOOKUP(RC[-5],商品マスタT!R3C1:R65C4,4,FALSE)))"
.Range("L" & MxR + 1).Resize(DtCount).Formula = _
"=IF(ISERROR(RC[-5]*RC[-2]),0,RC[-5]*RC[-2])"
.Range("M" & MxR + 1).Resize(DtCount).Formula = _
"=IF(ISERROR(RC[-6]*RC[-2]),0,RC[-6]*RC[-2])"
.Range("N" & MxR + 1).Resize(DtCount).Formula = _
"=IF(ISERROR(RC[-2]-RC[-1]),0,RC[-2]-RC[-1])"
.Range("O" & MxR + 1).Resize(DtCount).Formula = _
"=IF(ISERROR(RC[-1]/RC[-3]),0,RC[-1]/RC[-3])"
.Calculate '★追加：データマスタシートだけ、再計算
'↓J:Q列の範囲を まとめて値化
.Range("J" & MxR + 1).Resize(DtCount, 8).Value = .Range("J" & MxR + 1).Resize(DtCount, 8).Value
'↓AK:AL列の範囲の値を まとめて削除
.Range("AK" & MxR + 1).Resize(DtCount, 2).ClearContents
End With
'◇３ ◇２と同じ様に変更
With Worksheets("データマスタ")
'・・・・・・
End With
'★追加：計算方法を自動に
Application.Calculation = xlAutomatic
'◇４ はそのまま
'・・・・・・
End Sub
'------
この様に変更してみて下さい。
(HANA)
HANA様、大変解り易く教えていただき有難うございます。
頂いたコードで試した結果、爆速速度で動きました。体感速度は以前の10分の1です。 速すぎてちょっと叫んでしまいました。 でもデータマスタE列の顧客番号には最初の一行だけしか入力されません＞＜
（ゆん）
早く成りましたか。良かったですね。 では、(1)の方の問題に取りかかる事にします。
＞1．複数入力後、2つ目のWITH間のみがE列一番上の一行だけの入力になってしまう。
＞(1つ目のWITH間では単数のみの入力しかありません）
と言う事ですが、↑（下側の行）は
DtCount = Application.Count(Range("E$5:E$19"))
この結果 DtCountは必ず「1」（或いは0）である。
また
DtCount = Application.Count(Range("N$4:N$38"))
この結果 DtCountは「1」より大きい値に成る事がある
と言う事ですか？
該当のコードは
.Range("E" & MxR + 1).Resize(DtCount).Value = Range("AX3").Resize(DtCount).Value
この部分ですよね？
例えば、mxr が「3」で、DtCount が「5」だった場合 E4:E8のセルに AX3:AX7のセルの値を入力 と言う事になりますが、これで合っていますか？
AX3には「顧客番号」が入っているのでしょうね？ AX4,AX5等にも 同じ番号が入っているのですか？
.Range("H" & MxR + 1).Resize(DtCount).Value = Range("AC3").Value
の様にするのでは無いのかと思ってしまいますが。。。？
H4:H8のセルに AC3のセルの値を入力
(HANA)
HANA様、さっそくの御返信有難うございます。
>DtCount = Application.Count(Range("N$4:N$38"))
この結果 DtCountは「1」より大きい値に成る事がある
と言う事ですか？
１よりも大きい値もありえます。
>>該当のコードは
.Range("E" & MxR + 1).Resize(DtCount).Value = Range("AX3").Resize(DtCount).Value
この部分ですよね？
この部分です。
>>例えば、例えば、mxr が「3」で、DtCount が「5」だった場合 E4:E8のセルに AX3:AX7のセルの値を入力 と言う事になりますが、これで合っていますか？
AX3には「顧客番号」が入っているのでしょうね？ AX4,AX5等にも 同じ番号が入っているのですか？
AX3には顧客番号が入っていますが、AX3のみにしか入っていません。これです ね、説明不足で申し訳ありませんでした。AX4、AX5には何の値も入っていません。 A1のNOW関数が1セルでB,C,Dに反映されているので、こっちも同じように1セルで反映し てくれるものだとばかり。。。
（ゆん）
＞A1のNOW関数が1セルでB,C,Dに反映されているので
例えば、
.Range("B" & MxR + 1).Resize(DtCount).Value = Right(Year(Range("A1").Value), 2)
の部分の事ですね？
少しごちゃごちゃしているので、関数から出してみます。
.Range("B" & MxR + 1).Resize(DtCount).Value = Range("A1").Value
例えば、mxr が「3」で、DtCount が「5」だった場合 B4:B8の範囲に A1 の値を入力します。
B4:B8の範囲に A1:A5 の範囲の値を入力しているわけではありません。
感じとしては 一．A1セルをコピーして、B4:B8セルを選択して貼り付け 一．A1:A5セルをコピーして、B4:B8セルを選択して貼り付け の二つの結果が違うのと 同じイメージでしょうか。
.Range("F" & MxR + 1).Resize(DtCount).Value = Range("R8").Resize(DtCount).Value
.Range("H" & MxR + 1).Resize(DtCount).Value = Range("AC3").Value
構造としてはこの二つのコードの違いですね。
顧客番号に関しても、その下の AC3やR20と同じように変更してみて下さい。
あれ？それにしても、AK列って何か入力されてます？ ClearContents してますが。。。
(HANA)
HANA様、御返信有難うございます。今さきほど起きました。少し寒いですが、良い朝です。
AK列に値が無いのに「いや、まてよ。。これ消したら何かが動かなくなるんじゃないか？」と怖くて消 せなくて、それを突っ込まれるのもちょっと怖くて。。それが3週間頭の隅でヌルヌル気になりながら AK列に反応しているマクロを今削除しました。快適、爆速で動作しております。
ありがとうございました、また何か有りましたら宜しくお願い致します！
（ゆん）
せっかく動いているコードですが、もう少しまとめてみませんか？
一つ目の「With 〜 End With」は、
DtCount = Application.Count(Range("E$5:E$19"))
の結果が必ず「1」ですね？
でしたら、この中にある「.Resize(DtCount)」の部分は不要ですね。
ただ、消す前に 二つの「With 〜 End With」について考えてみてください。
たとえば、
.Range("B" & MxR + 1).Resize(DtCount).Value = Right(Year(Range("A1").Value), 2)
が２ヶ所に出て来ますが、結局 年の下2桁を入れる行数は
DtCount = Application.Count(Range("N$4:N$38")) に、+1（E列に関する処理分）の行数ですね？
.Range("B" & MxR + 1).Resize(DtCount + 1).Value = Right(Year(Range("A1").Value), 2)
他の部分も同様だと思います。
ただ、二つのコードで違う部分
.Range("F" & MxR + 1).Resize(DtCount).Value = Range("R8").Resize(DtCount).Value
.Range("F" & MxR + 1).Resize(DtCount).Value = Range("R11").Resize(DtCount).Value
は、一つにはまとめられないので
.Range("F" & MxR + 1).Value = Range("R8").Value
.Range("F" & MxR + 2).Resize(DtCount).Value = Range("R11").Resize(DtCount).Value
上側のコードは「.Resize(DtCount)」を消して
下側のコードは データを入れる先頭セルの行が「MxR + 2」に変更に成ります。
共通部分を一つにまとめて行くと、コードももう少しすっきりするのではないかと思います。
また「MxR」の変数は必ず「+1（以上）」で使われます。
最終行を取得した段階で、データを書き出す先頭行として変数に入れておくと
LRO1 = .Range("B" & Rows.Count).End(xlUp).Row + 1
.Range("B" & MxR + 1).Resize(DtCount).Value
↓
.Range("B" & LRO1).Resize(DtCount).Value
って感じで、一回毎に「+1」を書かなくても良く成ります。
(HANA)
コメント返信：
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.