• ベストアンサー

マクロ実行後、画面がちかちかしない方法

こんばんわ! VBAを実行すると、画面がちかちかします。 シートを行ったり来たりしているせいでしょうね? 自分で、色々やってみたのですが、エラーばかりで全然できません。 シートを行ったり来たりしなくてもいいVBAを作るには、どこを直せばいいでしょうか。 教えて頂けませんか? (現在のVBA) (1)「Data!FB63376,FG63376,FI63376」を「拾い出し!K4」にコピー&ペースト 値が入っている場合、下の行に貼付け。 Sub Macro1() Range("FB63376,FG63376,FI63376").Select   Range("FI63376").Activate Selection.Copy Sheets("拾い出し").Select If Range("K4").Value = "" Then Range("K4").Select Else Range("K" & Rows.Count).End(xlUp).Offset(1).Select  End If ActiveSheet.Paste Sheets("Data").Select (2)「Data!FO63367:FQ63372」を「拾い出し!O4」に値のみをコピー&ペースト 値が入っている場合、下の行に貼付け。 Range("FO63367:FQ63372").Select Selection.Copy Sheets("拾い出し").Select If Range("P4").Value = "" Then Range("P4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Else Range("P" & Rows.Count).End(xlUp).Offset(1).Select End If Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Data").Select Application.CutCopyMode = False End Sub 以上です。 お分かりになる方教えて頂けませんか? 宜しくお願いします。

質問者が選んだベストアンサー

  • ベストアンサー
  • okormazd
  • ベストアンサー率50% (1224/2412)
回答No.2

いちいちSelectしなくてもいい。 Sub Macro1() Range("FB63376,FG63376,FI63376").Copy With Sheets("拾い出し") If .Range("K4").Value = "" Then .Range("K4").PasteSpecial Else .Range("K" & Rows.Count).End(xlUp).Offset(1).PasteSpecial End If End With というように。

pairakku
質問者

お礼

okormazdさん、回答ありがとうございました。 補足に書かせて頂きましたが、一つだけうまくいきません。 教えて頂けませんか。 よろしくお願いします。

pairakku
質問者

補足

okormazdさんが、回答ありがとうございました。 すごい短くなるんですね~ 教えて頂いたのを早速実行させて頂きました。 (結果) 「Data!FB63376,FG63376,FJ63376」⇒「Data!K4,L4,M4」へコピー 「Data!FP63367:FR63372」⇒「拾い出し!O4」へコピー (希望) 「Data!FB63376,FG63376,FJ63376」⇒「拾い出し!K4,L4,M4」へコピーしたいです。 二つ共 With Sheets("拾い出し")に しているのに、片方は「Data!K4,L4,M4」に、片方は「拾い出し!K4,L4,M4」になります。どこがいけないのでしょうか? Sub Macro1() Range("FB63376,FG63376,FJ63376").Copy With Sheets("拾い出し") If Range("K4").Value = "" Then Range("K4").PasteSpecial Paste:=xlPasteValues Else Range("K" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues End If End With Range("FO63367:FQ63372").Copy With Sheets("拾い出し") If Range("P4").Value = "" Then .Range("P4").PasteSpecial Paste:=xlPasteValues Else .Range("P" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues End If End With End Sub 申し訳ありませんが教えて頂けませんか?

その他の回答 (2)

  • OtenkiAme
  • ベストアンサー率77% (69/89)
回答No.3

こんにちは。 RangeがどのシートのRangeなのか明確に書くクセをつけましょう。 例えば、K4セルは、"拾い出し"シートにも"Data"シートにも存在しますよね。 Range("K4") と書かれたセル範囲は、親オブジェクトが示されていないのでアクティブシートが対象になります。つまり、"拾い出し"シートにも"Data"シートのセルにもなるんです。 一方、 Sheets("拾い出し").Range("K4") と書くと、親オブジェクトが指定されているので"拾い出し"シートのK4セルであることがきちんとエクセル君に伝わるのです。 質問者さんが提示されたコードでも . がRangeの前に書かれていないので、Withで指定されたオブジェクトが、親オブジェクトとして指定されておらず、アクティブシートが対象になって処理されているから意図した処理になっていないんです。 まず、Withステートメントを使う前にそれぞれのRangeの前にシート名を付け、その上でWithステートメントでオブジェクトをまとめるようにしてみてください。 Sub Macro1編集前() If Sheets("拾い出し").Range("K4").Value = "" Then   Sheets("Data").Range("FB63376,FG63376,FI63376").Copy _     Destination:=Sheets("拾い出し").Range("K4") Else   Sheets("Data").Range("FB63376,FG63376,FI63376").Copy _     Destination:=Sheets("拾い出し").Range("K" & Rows.Count).End(xlUp).Offset(1) End If Sheets("Data").Range("FO63367:FQ63372").Copy If Sheets("拾い出し").Range("P4").Value = "" Then   Sheets("拾い出し").Range("P4").PasteSpecial Paste:=xlPasteValues, _     Operation:=xlNone, SkipBlanks:=False, Transpose:=False Else   Sheets("拾い出し").Range("P" & Rows.Count).End(xlUp).Offset(1).PasteSpecial _     Paste:=xlPasteValues, Operation:=xlNone, _     SkipBlanks:=False, Transpose:=False End If Application.CutCopyMode = False End Sub Sub Macro1編集後() With Sheets("拾い出し")   If .Range("K4").Value = "" Then     Sheets("Data").Range("FB63376,FG63376,FI63376").Copy _       Destination:=.Range("K4")   Else     Sheets("Data").Range("FB63376,FG63376,FI63376").Copy _       Destination:=.Range("K" & Rows.Count).End(xlUp).Offset(1)   End If   Sheets("Data").Range("FO63367:FQ63372").Copy   If .Range("P4").Value = "" Then     .Range("P4").PasteSpecial Paste:=xlPasteValues, _       Operation:=xlNone, SkipBlanks:=False, Transpose:=False   Else     .Range("P" & Rows.Count).End(xlUp).Offset(1).PasteSpecial _       Paste:=xlPasteValues, Operation:=xlNone, _       SkipBlanks:=False, Transpose:=False   End If End With Application.CutCopyMode = False End Sub

pairakku
質問者

お礼

OtenkiAmeさん、こんばんわ! 回答ありがとうございます。 >RangeがどのシートのRangeなのか明確に書くクセをつけましょう。 そうですね、Rangeをきちんと書かないと駄目ですね。 説明して頂いたのを、見て理解出来ました。 後、編集前・編集後と書けばわかりやすくていいですね。 みなさんのお陰で、うまく出来ました。 ありがとうございました。 今後共、よろしくお願いします。

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.1

長々とコードを載せているが関係ないのでは> http://www.serpress.co.jp/excel/vba035.html のように Application.ScreenUpdating = False(最後にTrueに戻す) を入れて仕舞いではないのですか。これはエクセルVBAの常識といったことですよ。 Googleででも「vba 画面の更新を止める」で照会すれば沢山記事がある。

pairakku
質問者

お礼

imogasiさん、回答ありがとうございました。 imogasiさんの、やり方で直りました。 ありがとうございました。 今後共、よろしくお願いします。

関連するQ&A

  • Excelでマクロを繰り返したい。

    Excelでマクロを記録したら以下のようになりました このマクロを以下の条件で繰り返したいのですが。 Sub Macro1() '------------- '----------------------- ' Sheets("Sheet1").Select Selection.AutoFilter Field:=4, Criteria1:="=5*", Operator:=xlAnd, _ Criteria2:="<>5@*" Range("A3:A302").Select Selection.Copy Sheets("Sheet2").Select Range("A3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet1").Select Range("A1").Select Selection.AutoFilter Field:=4, Criteria1:="=6*", Operator:=xlAnd, _ Criteria2:="<>6@*" Range("A3:A302").Select Selection.Copy Sheets("Sheet2").Select Range("B3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet1").Select Selection.AutoFilter Field:=4, Criteria1:="=7*", Operator:=xlAnd, _ Criteria2:="<>7@*" Range("A3:A302").Select Selection.Copy Sheets("Sheet2").Select Range("A103").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet1").Select Range("A1").Select Selection.AutoFilter Field:=4, Criteria1:="=8*", Operator:=xlAnd, _ Criteria2:="<>8@*" Range("A3:A302").Select Selection.Copy Sheets("Sheet2").Select Range("B103").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End Sub 条件= Field:は4~35位まで変動します 一連の動作をコピーして手作業で数字を変えてみたのですが プロージャが大きすぎてエラーになってしまいます。 何か良い方法は無いでしょうか?。

  • 色々なものを見ながら作っている初心者です。

    色々なものを見ながら作っている初心者です。 よろしくお願いします。 VBAでのエラー対処について 下記のマクロを実行すると、実行時 「Selection.Resize(, Selection.Columns.Count - 2).Select」のところで セルがブランクだった時にエラーが出てします。 対処の方法を教えていただけませんでしょうか? よろしくお願いします。 Sheets("sheetB1").Select Range("A7:C161").Select Application.CutCopyMode = False Selection.ClearContents Sheets("sheetA").Select Range("D12").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlToLeft)).Select Selection.Resize(, Selection.Columns.Count - 2).Select Selection.Offset(0, 1).Select Selection.Copy Sheets("sheetB1").Select Range("A7").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("sheetA").Select Range("E12").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("B1").Select Range("C7").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("sheetB2").Select Range("A7:C161").Select Application.CutCopyMode = False Selection.ClearContents Sheets("sheetA").Select Range("J12").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlToLeft)).Select Selection.Resize(, Selection.Columns.Count - 2).Select Selection.Offset(0, 1).Select Selection.Copy Sheets("sheetB2").Select Range("A7").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("sheetA").Select Range("K12").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("steetB2").Select Range("C7").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=Fals

  • マクロのコピペについて

    に実装する際の2回目の処理について助けてください。 Sub Action1or2() Static ChkNext As Boolean If ChkNext = False Then ChkNext = True MsgBox "1回目の押下です。" ' ' Macro1 Macro Range("L9").Select Selection.Copy Sheets("様式2(管理表)").Select Range("C10").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("様式1-1(作業用) ").Select Range("C9:K9").Select Application.CutCopyMode = False Selection.Copy Sheets("様式3(チェック表)").Select Range("B9").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("様式1-1(作業用) ").Select Range("L9").Select Application.CutCopyMode = False Selection.Copy Sheets("様式4(22F倉庫用) ").Select Range("D9").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("様式1-1(作業用) ").Select Else ChkNext = False Call Action2 End If End Sub Sub Action2() MsgBox "2回目の押下です。" 'ここに2回目の実行コードを記述 End Sub 2回目に実行ボタンをクリックした際にSheets("様式1-1(作業用) ")のアクティブセルと("Sheets様式2(管理表"))&"様式3(チェック表)")&"様式4(22F倉庫用) ")のA列にアクティブセルの値とイコールの値がある場合、アクティブセルの2行下の行を選択してコピーを行い、各シートの対象セルの行へ貼り付けをする場合どのような記述をすれば良いかご教示ください。 よろしくお願いします。

  • マクロについて教えてください

    マクロの超初心者です。 数式を入力しているのではなく、配付物をエクセルで作成しているのですが、同じもの(氏名や項目は違いますが)を100枚ほど作成しているのでマクロを・・・と思ったのですがやり方が全く分かりません。 sheet1からsheet2に下記のようにデータを写したいのですが、やり方を教えてください。 ●氏名が入力されています sheet1(A9) → sheet2(C2) sheet1(E9) → sheet2(C5) sheet1(I9) → sheet2(C8) ●項目1 sheet1(A8) → sheet2(E3) sheet1(E8) → sheet2(E6) sheet1(I8) → sheet2(E9) ●項目2 sheet1(A18~D18の結合セル) → sheet2(E2) sheet1(E18~H18の結合セル) → sheet2(E5) sheet1(I18~L18の結合セル) → sheet2(E8) と反映させたいのですが、250行あるのですが、 簡単にマクロで出来ないでしょうか?? ちなみに↓コレが上記の内容で作ってみたものです。 わかりずらい質問でスイマセン。 Range("A9").Select Selection.Copy Sheets("sheet2").Select Range("C2").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("E9").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("C5").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("I9").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("C8").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("A8").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E3").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("E8").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E6").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("I8").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E9").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("A18:D18").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E2").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("E18:H18").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E5").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets("sheet1").Select Range("I18:L18").Select Application.CutCopyMode = False Selection.Copy Sheets("sheet2").Select Range("E8").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False End Sub

  • マクロの記録を書きかえる

    下記の構文を可能な限り短くして書きたいのですが、 どのように省略出来るのかがわかりません。 <シート1のB列のデータの入力されているセルまでコピーし、シート2のA2から値で貼付ける> Range(\"B2\").Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets(\"Sheet1\").Select Range(\"A2\").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ご指導宜しくお願い致します。

  • Excel 繰り返しマクロ

    下記のようなマクロを使ってn個あるシートの内容を「集計」シートにコピーさせるようにしました。 (自動マクロとの組合せなので、スマートではないかもしれませんが) でも、これだと「集計」シートもコピー作業を行ってしまうので、 「集計」シートはコピー作業をしないように除外したいのですが、どうしたら良いのでしょう? 実際にはシート数は30程度、コピペ項目は1シートあたり30項目程度あります。 よろしくお願いします。 ------------------------- Sub テスト2() ' For i = 1 To Worksheets.Count '案件番号等コピー ' Sheets(i).Select Range("D3").Select Application.CutCopyMode = False Selection.Copy Sheets("集計").Select Range("A4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '案件名 Sheets(i).Select Range("F3").Select Application.CutCopyMode = False Selection.Copy Sheets("集計").Select Range("B4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '国名 Sheets(i).Select Range("E3").Select Application.CutCopyMode = False Selection.Copy Sheets("集計").Select Range("C4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '選択セルの解放 Application.CutCopyMode = False '行挿入 ' Sheets("集計").Select Rows("4:4").Select Selection.Insert Shift:=xlDown Next i End Sub

  • エクセルマクロ実行中に固まります

    単純処理を連発させているのですが、最後まで実行されず、 途中で固まってしまいます。こういう場合はどのように 対処したらよいのでしょうか? VBAに埋め込むとよいコードなどあれば教えてください。 コードのひとかたまりは下記のようなものです。 これを100連発ほどさせます。 Range("D4:K4").Select       ...計算式がはいっています Selection.Copy Range("D5:K16").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.Copy Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False

  • マクロ編集プリントアウト

    Sheets("Sheet1").Select Selection.Copy Sheets("Sheet2").Select Range("A3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet4").Select Application.CutCopyMode = False ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True Sheets("Sheet1").Select Range("A9").Select Sheets("Sheet1").Select Selection.Copy Sheets("Sheet2").Select Range("A3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet4").Select Application.CutCopyMode = False ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True Sheets("Sheet1").Select Range("A15").Select これで2回プリントアウトされていることになります。 6行ずつ下方にデータが続いています。 データ行数は常に変化します。 dim i as long  for i = 3 to 99 step 6   if worksheets("Sheet1").cells(i, "A") = "" then    worksheets("Sheet2").range("A3:H8").value = worksheets("Sheet1").cells(i - 6, "A").resize(6, 8).value       end if  next i を使用してうまくまとめることはできるでしょうか?

  • エクセルマクロ 繰り返して、別のシートへコピーしたい

    エクセルマクロ 繰り返して、別のシートへコピーしたい マクロ初心者のため、やり方が全くわかりません。 どなたか教えてください。 やりたいことは、 コピーするシートはあらかじめ作成しています。 簡素化の方法がわからないので、 とりあえず自分で作ってみたものが下にあるものです。 繰り返す方法がわからないので、 どなたか教えてください。 よろしくお願いします。 以下、作成したマクロです。 1行目から10行目まで繰り返したくて、 1行目から2行目のセルの移動の差は10行目までかわりません。 '1行目 Sheets("Sheet1").Select Range("B14:C14").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet2").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False Sheets("Sheet1").Select Range("B15:C17").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet2").Select Range("B1").Select Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False '2行目 Sheets("Sheet1").Select Range("B18:C18").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet2").Select Range("A2").Select Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False Sheets("Sheet1").Select Range("B19:C21").Select Application.CutCopyMode = False Selection.Copy Sheets("Sheet2").Select Range("B2").Select Range("B2").Select Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False

  • こんなマクロなんですが。

    下記のマクロでエクセルの表からデータ(文字列)を取得するようにしたいとおもっています。 Range("B23").Select Selection.Copy Range("F23").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Application.CutCopyMode = False Range("B24").Select Selection.Copy Range("F24").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Range("B25").Select Application.CutCopyMode = False Sheets("September 03").Copy Before:=Sheets(2)          ←ここ Selection.Copy Sheets("September 03 (2)").Select                   ←ここ Sheets("September 03 (2)").Name = "September 10"       ←ここ Range("B33").Select Application.CutCopyMode = False ActiveWindow.SmallScroll Down:=-15 Range("F12:L18").SelectEnd Sub と、まだ続くんですが、とりあえずここまでで。 番地のデータを取り込むようにしたいんですが、うまくいきません。 ←ここ っていうのがまさにそれです。

専門家に質問してみよう