Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

3783 / 76735

←次へ　｜　前へ→


	【78581】大容量Dataのシート間のコピーについて

VBA初心者 - 16/11/18(金) 10:42 -


	引用なし

	パスワード

初めまして、自分の仕事でどうしても大容量のDataのコピーをしたいのですが
処理に非常に時間(1時間程度）がかかってしまい、困っております。
現実的にこれぐらいのData量を処理するのにどれくらいで出来るかのがわかっていないので的違い質問だったらすみません。

まだ、VBAを始めたばかりで、アドバイス頂けると助かります。

それでは、よろしくお願いします。

○やりたいこと
コピー元(Sheet1)が、45000行で16列の16進数があり、
それをコピー先(Sheet2)には3行ずつを1行に纏めて、15000行で48列という形に
変更したいのです。

○自分が作ったソース

Sub Macro1()
'
' Macro1 Macro
'

Dim t As Single
Dim m(800000) As String
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")

t = Timer
'
' Prevents screen refreshing
　　Application.ScreenUpdating = False
' Prevents auto recalculation
　　Application.Calculation = xlCalculationManual

n = 0
v = 0

For j = 1 To 45000
DoEvents
　　For i = 0 To 15
　　　　m(n) = ws1.Cells(1 + j, 1 + i)
　　　　n = n + 1
　　Next i
　　' Shows progress situation
　　　　Application.StatusBar = "Processing " & j & " row"
Next j

For u = 1 To 15000
DoEvents
　　For l = 1 To 48
　　　　ws2.Cells(1 + u, l) = m(v)
　　　　v = v + 1
　　Next l
　　　　' Shows progress situation
　　　　Application.StatusBar = "Processing " & u & " Write"

Next u

'下記のプログラムだと9344.96秒かかってしまうので、配列処理に変更
'For j = 0 To 15499
'DoEvents
'　　 For i = 0 To 47
'　　　　If i < 16 Then
'　　　　　　ws2.Cells(2 + j, i + 1) = ws1.Cells(2 + 3 * j, 1 + i)
'　　　　ElseIf i < 32 Then
'　　　　　　ws2.Cells(2 + j, i + 1) = ws1.Cells(3 + 3 * j, i - 15)
'　　　　Else
'　　　　　　ws2.Cells(2 + j, i + 1) = ws1.Cells(4 + 3 * j, i - 31)
'　　　　End If
'Next i
'　　' Shows progress situation
'　　　　Application.StatusBar = "Processing " & j & " row"
'Next j

'Next i' Restore recalc setting
　　Application.Calculation = xlCalculationAutomatic

Debug.Print "処理時間は " & Round(Timer - t, 2) & " 秒です。"

End Sub

9 hits

▼

【78581】大容量Dataのシート間のコピーについて VBA初心者 16/11/18(金) 10:42