こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

Excel マクロのループ処理の高速化

 0 ,10 ,20 ,30 ,40 ,50 ,60 ,70 ,80 ,90 ,100 という11種類の数値が、1000個あります。

(1)1000個の数値を収めた列からC6:C20 に20 個無作為抽出し、コピーして E6:E20 にペーストします。
(2)このとき、C6:C20 には新たな数値が20 個無作為抽出されます。
(3)E6:E20 のデータを G6:Z6 にペーストする。

 以上を1000回繰り返します(G6~G1005:Z6~Z1005)。1回実施してマクロ登録して、以下のように少し訂正して実施したのですが、高々1000個のデータなのに1分以上かかります。画面がちらついて計算の様子が表示されるので遅いのでしょうか? 高速化できる方法を教えてください。
Sub Macro1()
  For N = 1 To 1000
    Range("C6:C20").Select
    Selection.Copy
    Range("E6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Copy
    RangeStr = "G" & CStr(N + 5) & ":" & "Z" & CStr(N + 5)
    Range(RangeStr).Select    'N=1 ⇒ Range("G6:Z6").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
      False, Transpose:=True
  Next N
End Sub

投稿日時 - 2018-10-10 11:16:37

QNo.9546131

困ってます

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

提示されているコードの高速化なら
取敢えず
Sub Test()
  Dim N As Long
  Application.ScreenUpdating = False
  For N = 1 To 1000
    With Range("E6:E20")
      .Value = Range("C6:C20").Value
      Cells(N + 5, "G").Resize(, 15).Value = Application.Transpose(.Value)
    End With
  Next N
  Application.ScreenUpdating = True
End Sub
配列で処理するなど、まだまだ高速化は出来るでしょう

投稿日時 - 2018-10-10 11:54:56

お礼

すばやい回答ありがとうございました。早速試してみます。

投稿日時 - 2018-10-10 12:18:01

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(2)

ANo.2

ご提示のコードではV~Z列は何も入らないように思えますが?


CopyやSelect、Pasteを使うと遅くなります。
ScreenUpdatingで画面の更新を押さえると大分早くなりますが出来ればCopyやSelect、Pasteを使わない方が良いです。

G~U列に張り付けるコードを作ってみました。
また、一旦E6:E20にコピーする理由も良く解らなかったので直接C6:C20の値を使用しています。

Sub Sample()
  For N = 1 To 1000
    RangeStr = "G" & CStr(N + 5) & ":" & "U" & CStr(N + 5)
    Range(RangeStr).Value = WorksheetFunction.Transpose(Range("C6:C20").Value)
  Next N
End Sub

投稿日時 - 2018-10-10 12:06:15

お礼

> ご提示のコードではV~Z列は何も入らないように思えますが?
Range("C6:C25").Select
でした。
> 一旦E6:E20にコピーする理由
 こうしないと毎回同じサンプリングになってしまうからです。やむなくしている状況です。

貴重なアドバイスまことにありがとうございました。

投稿日時 - 2018-10-10 12:17:12

あなたにオススメの質問