Excelコピペの高速化方法とは?

このQ&Aのポイント
  • Excelでのコピペ作業を高速化する方法について教えてください。
  • 現在Excelでコピペ作業を行っていますが、処理が遅くなっています。改善方法があれば教えてください。
  • Excelでのコピペ作業を効率化する方法を教えてください。
回答を見る
  • ベストアンサー

コピペマクロを高速化したい(Excel)

見よう見まねで以下のようなコードを書いてみたのですが、 これだと表示にやや時間がかかるので改善したいです。 ------ Sub コピペ() Dim i As Long i = Range("A1") Range("C12").Value = Worksheets("sheet2").Cells(i, 2).Value Range("D12").Value = Worksheets("sheet2").Cells(i, 3).Value Range("E12").Value = Worksheets("sheet2").Cells(i, 4).Value Range("F12").Value = Worksheets("sheet2").Cells(i, 5).Value Range("G12").Value = Worksheets("sheet2").Cells(i, 7).Value ------ こんな感じでコピペしたい値があと15個くらいあります。 コピー元とコピー先のセル配置には法則性があまりありません。 よろしくお願いします。

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

  • ベストアンサー
  • keithin
  • ベストアンサー率66% (5278/7940)
回答No.2

そのマクロで「遅いと感じられる」のでしたら、それはマクロのせいじゃなくシートの問題と考えられます。 #あるいはご相談に関係ないと思って掲示しなかった箇所のマクロが実は遅い直接の原因なのかも?しれませんが、それはこのご相談ではどーしようもない範疇なので、そういう事は無いとします。 対処の例: sub macro1()  dim i as long  i = range("A1")  application.calculation = xlcalculationmanual  range("C12:F12").value = worksheets("Sheet2").cells(i, "B").resize(1, 4).value  range("G12").value = worksheets("Sheet2").cells(i, "G").value  application.calculation = xlcalculationautomatic end sub みたいなカンジで、再計算を抑制して効果があるか見てみます。

love-DIY
質問者

お礼

解決しました! 再計算の問題だったようです。 ありがとうございました。

その他の回答 (1)

  • warpspace
  • ベストアンサー率56% (83/147)
回答No.1

画面描画の抑止・抑止解除を使用すれば、早くなります。

参考URL:
http://officetanaka.net/excel/vba/speed/s1.htm
love-DIY
質問者

お礼

残念ながら画面描画の問題ではありませんでした。 ありがとうございました。

関連するQ&A

  • Excelのマクロについての質問です。マクロに関しては初心者です。

    Excelのマクロについての質問です。マクロに関しては初心者です。 温度を計測する実験をしています。sheet1に計測している数値が更新されていってどんどん書き込まれている状況です。 Dim fStop As Boolean 'グローバル変数を宣言 Private Sub Command1_Click() ' ' Macro1 Macro ' ' Dim iRows As Integer Dim sRows As String Dim i As Integer Dim tm As Single fStop = Fal For i = 1 To 500 Cells(1, 1) = i tm = Timer() + 5 Do DoEvents Loop While Timer() < tm ' 最終行の調査: iRows = Worksheets("Sheet1").UsedRange.Rows.Count ' 最終行をシート3にコピー Worksheets("Sheet1").Rows(iRows).Copy Destination:=Worksheets("Sheet4").Range("1:1") ' CH1 の最新データをシート3にコピー Worksheets("Sheet3").Range("B9").Value = Worksheets("Sheet1").Cells(iRows, 3).Value ' CH2 の最新データをシート3にコピー Worksheets("Sheet3").Range("C9").Value = Worksheets("Sheet1").Cells(iRows, 4).Value ' CH3 の最新データをシート3にコピー Worksheets("Sheet3").Range("D9").Value = Worksheets("Sheet1").Cells(iRows, 5).Value Next i End Sub Private Sub Command2_Click() fStop = True End Sub 上記のプログラムを作り、sheet1に書き込まれていってる数値の一番新しい数値のみをsheet3の特定のセルの場所に更新されていくように作りました。(コマンドボタン1で計測を開始、コマンドボタン2で計測終了) しかし計測する場所が増えるにつれて下記の部分のプログラムを増やさなければいけません。このプログラムを一まとめにして、指定されたsheet3のセルに書きこまれるようにしたいのですが、どのようなプログラムを加えればいいのでしょうか?Excelのバージョンは2003です。 ' CH1 の最新データをシート3にコピー Worksheets("Sheet3").Range("B9").Value = Worksheets("Sheet1").Cells(iRows, 3).Value ' CH2 の最新データをシート3にコピー Worksheets("Sheet3").Range("C9").Value = Worksheets("Sheet1").Cells(iRows, 4).Value ' CH3 の最新データをシート3にコピー Worksheets("Sheet3").Range("D9").Value = Worksheets("Sheet1").Cells(iRows, 5).Value

  • VBA コピペ Range エラー

    いつもありがとうございます。 https://okwave.jp/qa/q9586463.html この質問のコードを自力で実務用に改変中です。 GetShe.Range(Cells(RowCnt, 1), Cells(RowCnt, 2)).Copy PutShe.Cells(PutRowCnt, 1) ↑このコードでRangeメソッドが失敗しましたというエラーが出るのですが、超初心者のため、原因がわかりません。 GetSheシートのRowCnt行の1列目と2列目をコピーして、PutSheシートのPutRowCnt行の1列目に貼り付けしたいです。 ○番目のシート、行という意味です。 お願いします。 Sub msukei6() ' 変数を宣言 Dim GetShe As Worksheet Dim PutShe As Worksheet Dim SheCnt As Long Dim RowCnt As Long Dim ColCnt As Long Dim PutRowCnt As Long Dim x As Long ' このブックに何シートあるか調べる SheCnt = ThisWorkbook.Worksheets.Count ' "集計"シートが抽出先である Set PutShe = ThisWorkbook.Worksheets("集計") PutRowCnt = 9 For SheCnt = 4 To 6 ' コピー元は4シート目~6シート目 Set GetShe = ThisWorkbook.Worksheets(SheCnt) ' 各シートの氏名をカウントする x = WorksheetFunction.CountA(GetShe.Range("b3:b100")) Do For RowCnt = 3 To x + 3 ' コピー元は3行目からコピーする If GetShe.Cells(RowCnt, Worksheets("集計").Cells(4, 2)) <> "" Then PutRowCnt = PutRowCnt + 1 GetShe.Range(Cells(RowCnt, 1), Cells(RowCnt, 2)).Copy PutShe.Cells(PutRowCnt, 1) End If Next RowCnt Exit Do Loop Next SheCnt End Sub

  • エクセルマクロで教えてください

    Sub smp05_14_01() Dim 対象セル As Range Dim ws1 As Worksheet Dim ws2 As Worksheet Dim ws3 As Worksheet Dim 行 As Long, 列 As Long Dim i As Long Set ws1 = Worksheets("顧客") Set ws2 = Worksheets("売上") Set ws3 = Worksheets("顧客未登録") 行 = ws1.Range("A1").End(xlDown).Row - 1 列 = ws1.Range("A1").End(xlToRight).Column Set 対象セル = ws1.Cells(1, 列 + 2).Resize(2, 行) For i = 1 To 行 対象セル(1, i).Value = "顧客NO" 対象セル(2, i).Value = "<>" & ws1.Cells(i + 1, 1) Next ws2.Range("A1").CurrentRegion.AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=対象セル, _ CopyToRange:=ws3.Range("A1") 対象セル.Clear End Sub 上記のマクロは売上のシートに登録されている以外の顧客NOを顧客シートを参照して顧客未登録シートにコピーするのもですが添付したファイルの数だと上手くいくのですが、エクセルのヨコのセルの最大値の258を越えると上手くいきません。上記の処理で1000レコードを越えても売上シートに登録されている以外の顧客NOを参照して顧客未登録シートにコピーするマクロを教えてください。

  • EXCEL2003 VBAで動作が速くなるようにマクロ記述したいのです

    EXCEL2003 VBAで動作が速くなるようにマクロ記述したいのですが、どのように行えばいいのでしょうか? Sheet1のA1からA300まで、関数によって計算されたデータが格納されています。 そのA1からA300の値(関数の計算結果のみ)を、コマンドボタンをクリックした時にSheet2のA1からA300にコピーしています。 コマンドボタンをクリックする度に、Sheet1のA1からA300までの値を、Sheet2に列を変えてコピーし、値を蓄積する方法を取っています。 以下のマクロを記述して走らせてみましたが、動作が遅いのが気になります。 コピーして貼り付けている動作が遅くなっているのでしょうか? もう少し早くなる方法はありますでしょうか? よろしくお願いします。 Sub CommandButton1_Click1() Dim I Dim N Worksheets("sheet1").Range("F1").Value = Range("F1").Value + 1 N = Worksheets("sheet1").Range("F1").Value For I = 1 To 300  Application.ScreenUpdating = False   Worksheets("sheet1").Cells(I, 1).Copy   Worksheets("sheet2").Cells(I, N).PasteSpecial Paste:=xlValues  Application.ScreenUpdating = True Next End Sub

  • Excelマクロのことで教えて下さい

    初歩的なことですみません。 E列の値をF列に値を入れるために下記のマクロを組みました。 Sub test() Worksheets("Sheet1").Select Dim i As Long For i = 2 To Cells(Rows.Count, 4).End(xlUp).Row Range("F2").Value = "=E2/1024/1024" Cells(i, 6).FillDown Range(Cells(2, 6), Cells(i, 6)).Copy Range("F2").PasteSpecial Paste:=xlValues Next i End Sub ところがF列に「値のみを貼り付け」をした時に、途中から同じ値のみがコピーされてしまい困っています。 (画像参照) うまく貼り付けることができるマクロをお教え下さい。 よろしくお願いいたします。

  • ExcelのVBAの配列に関する質問です。

    ExcelのVBAの配列に関する質問です。 sheet1のデータをsheet2に表示するVBAを作成しています。。 sheet1のデータは7行目からスタートし、sheet2のデータは26行目からスタートしています。。 sheet1とsheet2の列は同じ並びではないため、それぞれのシートの列番号をCellsを用いて指定しています。 Sub test1() Dim endrow As Long endrow = Worksheets("sheet1").Range("A65536").End(xlUp).Row Dim i As Long Dim j As Long For i = 7 To endrow j = i + 19 Worksheets("sheet2").Cells(j, 1) = Worksheets("sheet1").Cells(i, 2) Worksheets("sheet2").Cells(j, 8) = Worksheets("sheet1").Cells(i, 28) Worksheets("sheet2").Cells(j, 9) = Worksheets("sheet1").Cells(i, 31) Worksheets("sheet2").Cells(j, 10) = Worksheets("sheet1").Cells(i, 32) ・ ・ ・ ※長いので省略 Next i End Sub 上記のtest1は正常に動くのですが、データ量が多いため、処理に時間がかかってしまいます。 高速化できないかと、以下のように変更しました。 Sub test2() Dim dataRange1 As Variant Dim dataRange2 As Variant dataRange1 = Worksheets("sheet1").Range("A1:GI10006") dataRange2 = Worksheets("sheet2").Range("A1:DZ10018") Dim endrow As Long endrow = Worksheets("sheet1").Range("A65536").End(xlUp).Row Dim i As Long Dim j As Long For i = 7 To endrow j = i + 19 dataRange2(j, 1) = dataRange1(i, 2) dataRange2(j, 8) = dataRange1(i, 28) dataRange2(j, 9) = dataRange1(i, 31) dataRange2(j, 10) = dataRange1(i, 32) ・ ・ ・ ※長いので省略 Next i End Sub test2は、エラーメッセージ等は表示されませんが、sheet2にデータが表示されません。 ちなみに、以下のようにsheet1のみ配列化した場合は、正常に表示されました。 Worksheets("sheet2").Cells(j, 1) = dataRange1(i, 2) Worksheets("sheet2").Cells(j, 8) = dataRange1(i, 28) Worksheets("sheet2").Cells(j, 9) = dataRange1(i, 31) Worksheets("sheet2").Cells(j, 10) = dataRange1(i, 32) test2は、どこが間違っているのでしょうか? ご教示ください。 よろしくお願いいたします。

  • VBA Next For でのコピペについて

    EXCEL VBA初心者です。 AシートEW44からGD44までをコピーしてBというシートの最終行へコピーしたいです。 今下記のように組んでいるのですが、うまく作動しません。 Private Sub CommandButton1_Click() Dim i As Integer For i = 153 To 186 row1 = Worksheets("B").Cells(Rows.Count, 27).End(xlUp).Row Worksheets("A").Cells(i, 44).Value = Worksheets("B").Cells(row1 + 1, 27).Value Next i End Sub アドバイスいただけませんでしょうか。

  • データ抜き出しマクロについて

    以下のプログラムは10行ごとにデータを抜き出すプログラムです。 これに追加して例えば5結果の変動があったとき、10%結果の変動が あった時にデータを抜き出すようにするにはどうすればいいですか? Sub nukitori() Dim X As Worksheet Dim i As Long Dim ii As Long Dim col As Integer Dim Nukitori_Step As Long Nukitori_Step = 10 i = 2 ii = 2 '●●●見出し行が1行目なので2で始める Set X = ActiveSheet '●シートShordataがあったら削除 On Error Resume Next Application.DisplayAlerts = False Worksheets("shortdata").Delete Application.DisplayAlerts = True On Error GoTo 0 Worksheets.Add.Name = "shortdata" '●先ず、見出しをコピー Worksheets("shortdata").Rows(1).Value = X.Rows(1).Value While X.Cells(i, 1) <> "" And i < 65535 For col = 1 To 255 Worksheets("shortdata").Cells(ii, col).Value = X.Cells(i, col).Value Next If i = 2 Then i = 1 i = i + Nukitori_Step ii = ii + 1 Wend End Sub

  • Excel2007で最下行のコピーについて

    Excel2007で最下行のコピーについてなんですが、上手くいきません。そこで質問させて頂きます。 sheet3のセルO6、セルP6、セルQ6から下に向かって5000行目までに格子と関数が既に入ってます。 が、しかしコピーをしたい数値は今のところはO、P、Qの6行目にとどまっています。なので最下行はセルOPQの6行目になります。 sheet3のセルOPQの最下行数値をsheet4のセルABCの2行目にコピぺしたいです。 そこで作ってみました。基軸と言いますかsheet1を選択してから標準モジュールに Sub test() Worksheets("sheet3").Select Dim n As Long,t As Long n = Cells(Rows.Count,"O").End(xlUp).Row + 1 t = Cells(Rows.Count,"Q").End(xlUp).Row + 1 Range("O" & n, "Q" & t).Value.Select Selection = Worksheets("sheet4").Range("A2:C2").Value End Sub と書きましたがエラーになります。どの様すればよろしいですか?お願い致します。

  • VBA 別シートからコピー貼付け(複数列)

    別シートからコピー貼付け(複数列)をしたいのですが,同一シートからのコピー貼付けはネットから以下のマクロでできました。 しかし,別シートsheet1からsheet2ヘコピーで修正しましたが,「アプリケーション定義またはオブジェクト定義のエラーです。」となります。どなたかご教授よろしくお願いします。 修正したマクロ Sub sampel() Dim i As Long For i = 2 To Range("E65536").End(xlUp).Row Step 2 Sheets("sheet2").Range(Cells(i + 1, 2), Cells(i + 1, 85)).Value = _ Sheets("sheet1").Range(Cells(i, 5), Cells(i, 88)).Value Next i End Sub 参考としたマクロ http://www.excel.studio-kazu.jp/kw/20041208152106.html Sub sampel() Dim i As Long For i = 2 To Range("E65536").End(xlUp).Row Step 2 Range(Cells(i + 1, 2), Cells(i + 1, 85)).Value = _ Range(Cells(i, 5), Cells(i, 88)).Value Next i End Sub

専門家に質問してみよう