[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『同じ行数の入力と簡略化』(ゆん)
いつもお世話になっております。 以前、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さんからコメントがあるとは思いますが、2 に関して感想だけ。
特に無駄な処理があるわけでもなさそうなので、現状の処理速度が必ずしも 悪いというわけではないようです。 処理の時間はコードの量ではなく、処理するコードのステップとそれぞれの行 の実行時間の累積によって決まります。 今回のコードに冗長な部分があるわけでもないので、下手げにいじるよりは 現状のままの方がよいのではないでしょうか。
速度を早くしようとすると、式を使う処理をやめてコードで計算して値を直接 書くことにより改善は期待できますが、コード量は今の倍以上になると思います。 (Mook)
Mookさん、お世話になります。
ゆんさん、お久しぶりです。
(1)の方の質問に関しては 何の事をおっしゃっているのかわかりません。
コードを載せるだけではなく、 どのようなサンプルデータがあるのか。 このコードはどの様な事をするのか。 実行結果はどうなって欲しいのか。 実際の結果は希望に反してどうなるのか。 面倒でも、説明が必要だと思いますよ。
(2)の方は、どこが重いのですか? 最初の(Q6:AJ21をコピーして値貼り付けの)部分でしょうか? 次に続く、計算式を入力していく部分でしょうか?
それぞれ部分をバラバラにして 検証してみてください。
シート(ブック)に関する説明が全くないですので こちらでは、何がどのようになっているのかよくわかりません。
また、コードだけを載せてあるので、「そのコードで何をしているのか」 よくわかりません。
もしも、数式が大量に埋め込まれていて マクロが内容を変更する範囲のセルを参照していたら 再計算に時間がかかって、全体の処理速度が落ちているかもしれません。
これに関しては、いったん計算方法を手動にして実行した時 (結果はもちろん 違った値が表示されますが) すぐに終わるかどうかで 簡単な確認ができるのではないかと思います。
(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)の方の問題がある現在でも、コードは重いですか?
でしたら、以下の二つを確認してみて貰いたいです。
★1.どの部分で時間がかかっているのか 検証してみてください。 現在コードは大きく4つの部分に分かれていると思います。 ◇1.Unprotect 〜 Windows("Book1.xlsb").Activate ◇2.With Worksheets("データマスタ") − DtCount = Application.Count(Range("E$5:E$19"))− End With ◇3.With Worksheets("データマスタ") − DtCount = Application.Count(Range("N$4:N$38"))− End With ◇4.ClearContents 〜 Protect
独立させて(Sub ○○ ・・・ End Sub 4つにわける) それぞれ順番に実行して貰っても良いですが。。。。 ブレークポイントの設定を やってみて貰うのが良いかもしれません。
例えば コードが書いてある白い部分の左側に 灰色の部分が有ります。 その部分をクリックすると、茶色い●が表示されます。 コードを実行すると、一旦その部分で止まります。 再度「●」まで実行したい場合は、[F5]を押すか ツールバーの「■」の二つ左隣りにある「三角」を押して下さい。 (↑の画像では 書式(O) の下に位置している「三角」です) With Worksheets("データマスタ") の行2ヶ所と Range("E5:E19,N4:N38").ClearContents の行1ヶ所の 計3ヶ所に「●」を付けて 実行してみて下さい。
どの部分で時間がかかっていますか?
★2.いったん計算方法を手動にして実行した時すぐに終わるかどうか 計算方法の切替手順はこちらをご参考に。 http://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 の1行にして下さい。
(J列 mxr+1行)のセルから、 DtCount行と8列分(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_計算方法手動切替() '◇1 はそのまま '・・・・・・
'★追加:計算方法を手動に Application.Calculation = xlManual
'◇2 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
'◇3 ◇2と同じ様に変更 With Worksheets("データマスタ") '・・・・・・ End With
'★追加:計算方法を自動に Application.Calculation = xlAutomatic
'◇4 はそのまま '・・・・・・ 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」より大きい値に成る事がある と言う事ですか? 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ヶ所に出て来ますが、結局 年の下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.