このコードを実行するとエクセルがフリーズしてしまいます。

質問

とある為替データファイル（600KB）の編集をマクロで実行したい（何度も新規で編集するため）のですが画面がフリーズしてしまいます。たまに最後まで出来ます。長すぎるのでしょうか。省略できる部分があったら教えて欲しいです。（初心者です）

以下そのまま添付

Sub 画面を固定()
Application.ScreenUpdating = False
End Sub
Sub いち()
Call 画面を固定

Cells.Select
With Selection.Font
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With

'セルの結合を解除・折り返して全体を表示するの解除・文字を左詰で表示
With Selection
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.HorizontalAlignment = xlLeft '（文字を左詰で表示）
End With

'列の幅
Selection.ColumnWidth = 2.38
'行の幅
Selection.RowHeight = 12
'列の幅を自動調整
Cells.Select
Cells.EntireColumn.AutoFit
'A列の調整
Columns("A:A").ColumnWidth = 3

'不要行削除
Range("a:a,c:c,e:H,J:R,T:U,X:AA,AC:AO,AQ:Au,Aw:BB,BD:BG,BI:CC").Select
Selection.Delete Shift:=xlToLeft

'円マークを取る
Cells.Replace What:="\", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
'円の列の書式
Range("K:K,I:I").Select
Selection.NumberFormatLocal = "#,##0_ ;[赤]-#,##0 "

' 列の入れ替え()
'（建時）
Columns("G:G").Select
Selection.Cut
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
'（建値）
Columns("G:G").Select
Selection.Cut
Columns("C:C").Select
Selection.Insert Shift:=xlToRight

Columns("H:H").Select
Selection.Cut
Columns("e:e").Select
Selection.Insert Shift:=xlToRight

'スクロールで画面左に戻る
ActiveWindow.ScrollColumn = 1

'仕切取引まで行削除
On Error GoTo line
x = Application.WorksheetFunction.Match("仕切取引", Columns("A:A"), 0)
If x = 1 Then
Exit Sub
Else
Rows("1:" & x - 1).Delete
End If
Exit Sub
line:
MsgBox "見当たりません", vbCritical, "（＞＿＜） "

'一行目（仕訳取引）削除
Rows("1:1").Select
Selection.Delete Shift:=xlUp

'オートフィルタ
Rows("1:1").Select
Selection.AutoFilter

'不要列にかかったフィルタを削除
Columns("L:CE").Select
Selection.Delete Shift:=xlToLeft
End Sub

よろしくお願いします。

回答No.4

pauNed · ベストアンサー

ぁ、すみません。
あらためて流れを見直してみると、少し非効率な気が。
残すデータのほうが少ないですよね？
新規シートに必要データのみコピーしたほうがよくないでしょうか。

それが不都合ある場合でも、
まず不要行の削除、不要列の削除をして、その後にReplaceや書式設定や列幅行高の設定をしたほうが良いでしょう。
検討してみてください。

お礼

大変参考になりました。ご回答ありがとうございます。

回答No.3

pauNed

こんにちは。

まず、Cells.Selectでシート全体が対象ですから、
ここは .UsedRange に絞ったほうが良いかもしれません。
それと、対象データが多いとReplaceメソッドは負担かかります。
下記で改善しない場合、別案を検討したほうが良いかもしれません。

最低限の修正として、イベントの制御と範囲の絞込み、Selection排除、などをしてみました。

Sub いち改()
　　Dim x As Long

　　With Application
　　　　.ScreenUpdating = False
　　　　.EnableEvents = False
　　　　.Calculation = xlCalculationManual
　　End With
　　With ActiveSheet.UsedRange
　　　　With .Font
　　　　　　.Size = 9
　　　　　　.Strikethrough = False
　　　　　　.Superscript = False
　　　　　　.Subscript = False
　　　　　　.OutlineFont = False
　　　　　　.Shadow = False
　　　　　　.Underline = xlUnderlineStyleNone
　　　　　　.ColorIndex = xlAutomatic
　　　　End With
　　　　'セルの結合を解除・折り返して全体を表示するの解除・文字を左詰で表示
　　　　.WrapText = False
　　　　.Orientation = 0
　　　　.AddIndent = False
　　　　.ShrinkToFit = False
　　　　.ReadingOrder = xlContext
　　　　.MergeCells = False
　　　　.HorizontalAlignment = xlLeft　　'（文字を左詰で表示）
　　　　'列の幅
　　　　.ColumnWidth = 2.38
　　　　'行の幅
　　　　.RowHeight = 12
　　　　'列の幅を自動調整
　　　　.EntireColumn.AutoFit
　　　　'A列の調整
　　　　.Columns("A").ColumnWidth = 3
　　　　'不要行削除
　　　　.Range("A:A,C:C,E:H,J:R,T:U,X:AA,AC:AO,AQ:AU,AW:BB,BD:BG,BI:CC").Delete Shift:=xlToLeft
　　　　Application.Calculation = xlCalculationAutomatic
　　　　'円マークを取る
　　　　If Not .Find("*") Is Nothing Then .Replace What:="\", _
　　　　　　　　　　　　　　　　　　　　　　　　　 Replacement:="", _
　　　　　　　　　　　　　　　　　　　　　　　　　 LookAt:=xlPart, _
　　　　　　　　　　　　　　　　　　　　　　　　　 SearchOrder:=xlByRows, _
　　　　　　　　　　　　　　　　　　　　　　　　　 MatchCase:=False, _
　　　　　　　　　　　　　　　　　　　　　　　　　 SearchFormat:=False, _
　　　　　　　　　　　　　　　　　　　　　　　　　 ReplaceFormat:=False
　　　　Application.Calculation = xlCalculationManual
　　　　'円の列の書式
　　　　.Range("K:K,I:I").NumberFormatLocal = "#,##0_ ;[赤]-#,##0 "
　　　　' 列の入れ替え()
　　　　'（建時）
　　　　.Columns("G").Cut
　　　　.Columns("B").Insert Shift:=xlToRight
　　　　'（建値）
　　　　.Columns("G").Cut
　　　　.Columns("C").Insert Shift:=xlToRight
　　　　.Columns("H").Cut
　　　　.Columns("E").Insert Shift:=xlToRight
　　　　'スクロールで画面左に戻る
　　　　ActiveWindow.ScrollColumn = 1
　　　　'仕切取引まで行削除
　　　　On Error GoTo line
　　　　x = Application.WorksheetFunction.Match("仕切取引", .Columns("A"), 0)
　　　　If x > 1 Then
　　　　　　.Rows("1:" & x - 1).Delete
　　　　End If
　　　　GoTo endline
line:
　　　　MsgBox "見当たりません", vbCritical, "（＞＿＜） "
　　　　'一行目（仕訳取引）削除
　　　　.Rows(1).Delete Shift:=xlUp
　　　　'オートフィルタ
　　　　.Rows(1).AutoFilter
　　　　'不要列にかかったフィルタを削除
　　　　.Columns("L:CE").Delete Shift:=xlToLeft
　　End With
endline:
　　With Application
　　　　.EnableEvents = True
　　　　.Calculation = xlCalculationAutomatic
　　　　.ScreenUpdating = True
　　End With
End Sub

※実際のシート状況を見て修正したわけではありませんので、
※必ず、バックアップを取った上で試してください。

お礼

大変参考になりました。ご回答ありがとうございます。

回答No.2

gatyan

#1の方と同様に、処理に時間がかかっているだけのような気がします

可能性としては、画面の書き直しをしないことで処理の高速化ができるかもしれません

処理のはじめで
Application.ScreenUpdating = False
終わりで
Application.ScreenUpdating = true
を実行するようにしてみてください

お礼

やってみます！ご回答ありがとうございます。

回答No.1

Yamatoken

まず、
>フリーズしてしまいます。たまに最後まで出来ます。

という話なので、フリーズはしていないのでしょう。
処理が重い状態かと思います。

次にモジュールをパっと見た限りですが・・・
然程重い処理をさせる要素は少なそうかと。

が、列幅の自動調整に関してはExcel処理内では負荷のかかる
処理かと思います。（個人的には）

自動調整を外してどうなるか、というのを試されてみるのも
いいかと思います。

お礼

そうですか。試してみます。ご回答ありがとうございます。