Results of 1 - 1 of about 7929 for VLOOKUP (0.002 sec.)
- [[20110326225751]]
- #score: 3346
- @digest: 8cf949c0f77c51eb8a705594ad8e3dcc
- @id: 53902
- @mdate: 2011-03-28T14:11:39Z
- @size: 35158
- @type: text/plain
- #keywords: dtcount (1211688), タt (210161), mxr (125214), descuento (100153), r65c4 (91450), 品マ (72857), r171c4 (65413), r3c1 (59623), r7c2 (51665), 録"" (46493), resize (29511), rc (19200), control (18813), マス (17554), 未登 (15541), formula (14265), iserror (12646), 客番 (12424), タマ (12243), range (11126), スタ (9705), value (8285), 商品 (8105), タ") (6814), formular1c1 (5999), vlookup (5726), 算方 (4836), 値化 (4708), clearcontents (4532), 速度 (3394), false (3044), [- (2952)
- 『同じ行数の入力と簡略化』（ゆん）
いつもお世話になっております。 以前、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) ---- 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)の方の問題がある現在でも、コードは重いですか? でしたら、以下の二つを確認してみて貰いたいです。 ★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つにわける） それぞれ順番に実行して貰っても良いですが。。。。 ブレークポイントの設定を やってみて貰うのが良いかもしれません。 例えば http://www.excel.studio-kazu.jp/lib/e1nw/e1nw02.gif コードが書いてある白い部分の左側に 灰色の部分が有ります。 その部分をクリックすると、茶色い●が表示されます。 コードを実行すると、一旦その部分で止まります。 再度「●」まで実行したい場合は、[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)... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/201103/20110326225751.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97013 documents and 608132 words.
訪問者：