マクロの処理速度が遅い コピペ→削除→名前付保存

質問

マクロの処理速度が遅いため、大変困っています。お忙しいところ恐縮ですが、アドバイスいただけませんでしょうか。よろしくお願い致します。

作業は、30行×54列のデータの、コピペ→削除（ここまで4～5秒）→名前を付けて保存（トータル9～10秒）です。
30行はテストで、本当は500～1000行のデータを処理したいのですが、とても時間がかかり、PCが動かなくなってしまうこともあります。
ご指摘、いろいろあるかと思うのですが、細かな点でも教えてください。どうぞよろしくお願い致します。

詳細は、
元ファイルの"シート(1)”のデータ（●行×54列）を
ファイル（原紙）を開き、ファイル（原紙）の"貼り付け”のシートに貼り付けます。
元ファイルの"シート(1)”のデータ（●行×54列）は、元ファイルの"シート(2)”に移動します。
元ファイルの"シート(1)”のデータ（●行×54列）を削除します。
ファイル（原紙）に、日付ー■（通し番号）をつけて、保存します。
■は、保存先フォルダを確認し、通し番号にしています。
元ファイルは、他のシートにもいろいろデータがあり、7MBほどです。
時間測定の部分は、本番では不要です。

Sub test5()
Dim startTime As Double
Dim endTime As Double
Dim processTime As Double

'開始時間取得
startTime = Timer
Dim s1 As Worksheet
Set s1 = ActiveSheet
Dim nPasteRow As Double
Dim sHozon As String
Dim sFilename As String

'画面描画を静止
Application.ScreenUpdating = False
'自動再計算の停止
Application.Calculation = xlManual
'警告メッセージを非表示
Application.DisplayAlerts = False

'*****************************************
' 元ファイルのシート(1)　から　ファイル.xls　へ移動
'*****************************************
'ファイルを開く
Workbooks.Open "C:\Users\yyy\OneDrive\デスクトップ\フォルダー\ファイル.xls"
Sheets("貼り付け").Select
Set wbData = ActiveWorkbook
'最終行へ移動
If Range("A5").Value = "" Then
nPasteRow = 5
ElseIf Range("A6").Value = "" Then
nPasteRow = 6
Else
nPasteRow = Range("A5").End(xlDown).Row + 1
End If

Dim i As Long
Dim m As Long
For i = 5 To s1.Range("A4").End(xlDown).Row
For m = 1 To 54
wbData.Sheets("貼り付け").Cells(nPasteRow + i - 5, m).Value = s1.Cells(i, m).Value
Next m
Next i

'***************************
' 元ファイルのシート(1)　から　シート(2)へ移動
'***************************
Workbooks("元ファイル.xlsm").Activate

Dim s2 As Worksheet
Set s2 = ActiveSheet

'最終行へ移動
If Range("A3").Value = "" Then
nPasteRow = 3
ElseIf Range("A4").Value = "" Then
nPasteRow = 4
Else
nPasteRow = Range("A3").End(xlDown).Row + 1
End If

Dim n As Long
Dim o As Long
For n = 5 To s1.Range("A4").End(xlDown).Row
For o = 1 To 54
s2.Cells(nPasteRow + n - 5, o).Value = s1.Cells(n, o).Value
Next o
Next n

'*****************
' 移動した行削除
'*****************
Sheets("シート(1)").Rows("5:" & Range("A4").End(xlDown).Row).Delete
ActiveWorkbook.Save

'********************
' 行削除後の処理
'********************

Dim str1 As String
Dim str2 As String
Dim nCnt As Integer

'ファイルを開いた場合、名前をつけて保存を行う
Workbooks("ファイル.xls").Activate

'保存場所を指定
sHozon = "C:\Users\yyy\OneDrive\デスクトップ\フォルダー"

For nCnt = 1 To 20
'ファイル名を設定
sFilename = "ファイル" & Replace(Date, "/", "") & "-" & nCnt & ".xls"
Range("D2").Value = "ファイル" & Replace(Date, "/", "") & "-" & nCnt

'ファイルが存在しているか確認
str1 = sHozon & "\" & sFilename
str2 = Dir(str1)
If (str2 <> sFilename) Then
'ファイルが存在しない場合、保存

'名前をつけて保存
ActiveWorkbook.SaveAs Filename:= _
sHozon & "\" & sFilename, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False

Sheets("処理(1)").Select

Application.Goto Reference:=Range("E1"), Scroll:=True
Exit For
End If
Next

'自動再計算の再開
Application.Calculation = xlAutomatic
'画面描画を開始
Application.ScreenUpdating = True
'警告メッセージを表示
Application.DisplayAlerts = True

'終了時間取得
endTime = Timer

'処理時間表示
processTime = endTime - startTime
MsgBox "処理時間：" & processTime

End Sub

回答No.5

HohoPapa

他の方々からアドバイスがあるように、

Dim i As Long
Dim m As Long
For i = 5 To s1.Range("A4").End(xlDown).Row
For m = 1 To 54
wbData.Sheets("貼り付け").Cells(nPasteRow + i - 5, m).Value = s1.Cells(i, m).Value
Next m
Next i

や、

Dim n As Long
Dim o As Long
For n = 5 To s1.Range("A4").End(xlDown).Row
For o = 1 To 54
s2.Cells(nPasteRow + n - 5, o).Value = s1.Cells(n, o).Value
Next o
Next n

のような繰り返しの処理ではなく
複数セル範囲を1回で複写したほうが効率的と思います。

前者を例にすれば、私だったら

'//--------------------------------
Dim fsr As Long '複写元範囲開始行
Dim fsc As Long '複写元範囲開始列
Dim fer As Long '複写元範囲終了行
Dim fec As Long '複写元範囲終了列
fsr = nPasteRow
fer = nPasteRow + s1.Range("A4").End(xlDown).Row - 5
fsc = 1
fec = 54
Dim tsr As Long '複写先範囲開始行
Dim tsc As Long '複写先範囲開始列
Dim ter As Long '複写先範囲終了行
Dim tec As Long '複写先範囲終了列
tsr = 5
tsc = 1
ter = s1.Range("A4").End(xlDown).Row
tec = 54
Range(wbData.Sheets("貼り付け").Cells(fsr, fsc), wbData.Sheets("貼り付け").Cells(fer, fec)).Value = _
Range(s1.Cells(tsr, tsc), s1.Cells(ter, tec)).Value
'//--------------------------------

といったコードにします。
（動作確認していませんので、参考にするときはしっかりチェックしてください。

一方、この部分が原因で
>とても時間がかかり、PCが動かなくなってしまうこともあります。
ここまで悲惨な状況にはならないように思います。
たかだか１０００行ですから。

気になるのは、
> Workbooks.Open "C:\Users\yyy\OneDrive\デスクトップ\フォルダー\ファイル.xls"
この部分です。

課題マクロブックなどをOneDrive、あるいは
OneDriveと同期をとったフォルダーに配置している場合
いらぬ同期やi/oが起き、指摘の症状になる可能性があるものと思います。

先に説明したコードの改修に加え、
OneDriveとは無縁な場所で実行してみてください。

お礼

ありがとうございます。
１回の複写、間違えていました。
まとめてイコールということですね。
間違い→Range("A3:BD" & Range("A2").End(xlDown).Row).Select
Selection.Copy
Range("A" & nPasteRow & ":BD" & nPasteRow).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

ファイルの保存先についての助言もありがとうございます。実環境で確認してみたいと思います。

終盤に２か所、ファイルの保存を入れているのですが、F８で見ていったときに保存のところで時間がかかるように思います。こちらも実環境で改めて確認してみたいと思います。
まずはお礼申し上げます。

回答No.4

kon555

多分ですが、他のプログラムなどの経験はあるためVBA自体は構築可能なものの、エクセル操作自体には詳しくない感じですね？

　貴方の今のコードは、セルを一つコピーしてペーストして、次のセルをコピーしてペーストして・・・、という処理になっています。
　30行×54列程度なら、範囲で選択してコピーする形にすれば実用に耐える速度が実現できますよ。
　ここまで組めるなら、この辺りを参考にすればすぐに分かると思います。
http://officetanaka.net/excel/vba/cell/cell10.htm

　もっと大量のデータになるなら、一旦配列としてデータを取り込む事も出来ますが、1000行×54列程度なら不要だとは思います。
　ただ求めている速度次第でもあるので、参考ページを紹介しておきます。
http://officetanaka.net/excel/vba/speed/s11.htm
http://officetanaka.net/excel/vba/tips/tips124.htm

　vbaで何かする場合、基本的には「セルを操作する回数を減らす」のが速度アップに有効です。
　VBAはよく『遅い』と言われがちですが、かなりの量のデータでも、今のPCならコード次第で充分な速度になります。そもそも事務処理にゼロコンマ数秒の速度差は実質無意味ですからね。
　ただそのためには『プログラムの知識』だけでなく『Excelの操作方法の知識』と『vbaの仕様』を覚える必要があるため、ちょっと誤解されやすいのかなぁ、と思っていますが。

お礼

ありがとうございます。
必要に駆られて、調べながら、助けていただきながらという状況です。
参考ページ、ありがとうございます。
配列もわかっていないのですが、２次元配列でできるのでしょうか。

回答No.3

bardfish

COMオブジェクトとして処理しているように見えますが、意識はしていないでしょうね。

WindowsのCOMオブジェクトというのはレガシィテクノロジで今となっては処理速度では最低レベルです。
COMを使っている限り今より爆速になることはないでしょう。
私もExcel VBAを使用して10万行規模のシートをと処理するVBAを扱いましたがとてもじゃないけどおそすぎて我慢できなくなったのでAccessで作り直しました。
その御蔭で10分近くかかっていた処理が90秒で完了するまでに高速化。
最近ではAccessでも別の問題が浮上してきたためにSQL ServerとVisualBasic .NETでさらに作り直そうかと考えています。

Excel VBAが.NETに対応すれば今以上の高速化が期待できるんですけどね。VB.netでエクセルワークシートを使用するプログラムを作っても、ものすごく遅いです。改めて使いたくないと思いました(笑)

ということで、Excel VBAの処理というのは・・・ちょっとしたことをやらせるなら便利でしょうが、大量のデータ処理には向かないと思っています。Excelが登場したときからそういう印象を持っていたのでExcelはかなり便利な電卓以上には考えたことがないです。

ちなみに、SQL Server、VisualBasicは無料でDownload、インストール、使用できます。
VisualStudio Codeというエディターもありますが、JavaやPythonなどの開発/実行も可能。環境を正しく構築できていればリアルタイム構文チェックもやってくれます。

お礼

ありがとうございます。
エクセルの関数からスタートして、限界を感じVBAをかじっています。
新しいことに取り組むことも考えたいと思います。

回答No.2

noname#245936

補足で、うろ覚えですがcells関数で座標軸はA1などではなく数学で指示可能。
Rangeで矩形選択できたかと。

お礼

ありがとうございます！
まとめてイコールするということですね。
やってみようと思います。

回答No.1

noname#245936

画面の更新をOFFに、と言いたいところでしたがすでにできていますので。
あとはコピペの部分を1セルごとにループさせないで矩形範囲選択でコピー貼り付けさせると爆速になると思います