• ベストアンサー
※ ChatGPTを利用し、要約された質問です(原文:VBA マクロ処理時間の短縮について)

VBAマクロ処理時間の短縮方法

このQ&Aのポイント
  • VBAマクロの処理時間を短縮する方法について教えてください。
  • 現在のコードでは、マクロの実行に約30秒かかっています。
  • マクロの処理時間を短縮するためには、どのような変更が必要ですか?

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

  • ベストアンサー
  • ham_kamo
  • ベストアンサー率55% (659/1197)
回答No.2

No.1です。Resizeを使えばもうちょっと短くなることに気がついたので、改訂版です。 Sub A列のコピー()  Dim rw2 As Long  Dim rw1 As Long  Dim newdate As Date  With Worksheets("sheet1")   rw2 = .Cells(.Rows.Count, "c").End(xlUp).Row   newdate = .Range("c" & rw2).Value   For rw1 = rw2 - 1 To 1 Step -1    If .Range("c" & rw1).Value <> newdate Then Exit For   Next rw1   Worksheets("sheet2").Cells(6, "v").Resize(rw2 - rw1).Value = _   .Range(.Cells(rw1 + 1, 1), .Cells(rw2, 1)).Value   If rw1 + 26 <= rw2 Then    Worksheets("sheet2").Cells(40, "v").Resize(rw2 - (rw1 + 26) + 1).Value = _    .Range(.Cells(rw1 + 26, 1), .Cells(rw2, 1)).Value   End If  End With End Sub

taka1012
質問者

お礼

ご回答ありがとうございました。 試したところ、砂時計マークも出ず反応がかなり早くなりました。

その他の回答 (1)

  • ham_kamo
  • ベストアンサー率55% (659/1197)
回答No.1

とりあえず、形式を選択して値で貼り付けしている部分を、コピー先の範囲をRangeで明示的に指定して直接Valueを代入するようにしてみました。 検証はしていないので、違う結果になったり速くならなかったらすみません。 Sub A列のコピー()  Dim rw2 As Long  Dim rw1 As Long  Dim newdate As Date  With Worksheets("sheet1")   rw2 = .Cells(.Rows.Count, "c").End(xlUp).Row   newdate = .Range("c" & rw2).Value   For rw1 = rw2 - 1 To 1 Step -1    If .Range("c" & rw1).Value <> newdate Then Exit For   Next rw1     Worksheets("sheet2").Range(Cells(6, "v"), Cells(6 + rw2 - rw1), "v").Value = _   .Range(.Cells(rw1 + 1, 1), .Cells(rw2, 1)).Value   If rw1 + 26 <= rw2 Then    Worksheets("sheet2").Range(Cells(40, "v"), Cells(40 + (rw2 - (rw1 + 26) + 1)), "v").Value = _    .Range(.Cells(rw1 + 26, 1), .Cells(rw2, 1)).Value   End If  End With End Sub

関連するQ&A

専門家に質問してみよう