EXCEL VBA マクロ 実行する度に処理速度がどんどん遅くなる原因が知りたい

EXCEL VBA初心者です。
仕事でデータをExcelに貼り付け、マクロを実行させると月別のカートン数などを算出するマクロを作成しました。初めの頃は、5分程で処理が完了していたのですが、今では40分程かかるようになってしまいました。固まってしまうこともあります。
色々チェックしましたが、どこを直していいのかわかりません。はじめの方の繰り返し処理で時間がかかっているようなのですが。どなたか見ていただけないでしょうか。どうぞ宜しくお願いします。
Option Explicit
Sub 月別発注データ作成()
Dim i As Long
Dim myMsg As String
Dim myTitle As String
Dim NYUUKA_TUKI As String
Dim PACKING As Variant
Dim k As Long
Dim D As Range
myMsg = "現在の年月を入力して下さい。例）2017年9月4日→【201709】と入力"
myTitle = "入荷月の修正"
NYUUKA_TUKI = Application.InputBox(prompt:=myMsg, Title:=myTitle, Default:=201703, Type:=2)
'列Sに入荷月を算出
For i = 2 To Range("A1").End(xlDown).Row
Cells(i, "S").Value = Left(Cells(i, "H").Value, 6)
Next i
'①入荷日修正
For i = 2 To Range("A1").End(xlDown).Row
If Cells(i, 19).Value <= NYUUKA_TUKI Then
Cells(i, 19).Value = NYUUKA_TUKI
End If
Next i
' S列を文字列設定にする
Columns("S").NumberFormatLocal = "@"
'②Ｖ１～Ｖ○のデータを削除（仮発注の為不要）
For i = Range("A1").End(xlDown).Row To 2 Step -1
If Cells(i, "C").Value Like "V*" Then
Cells(i, "C").EntireRow.Delete
End If
Next i
'③パッキング4桁の修正
'パッキングを/で区切る
Range("T1").Value = "Packing1"
Range("U1").Value = "Packing2"
Range("V1").Value = "Packing3"
For i = 2 To Range("A1").End(xlDown).Row
PACKING = Split(Cells(i, "F").Value, "/")
For k = LBound(PACKING) To UBound(PACKING)
Cells(i, 20 + k) = PACKING(k)
Next k
Next i
'分けた項目からそれぞれ数字を取り出す
For i = 2 To Range("A1").End(xlDown).Row
If Cells(i, "V").Value = "" Then
Cells(i, "V").Value = Val(Cells(i, "U").Value)
Cells(i, "U").Value = Val(Cells(i, "T").Value)
Cells(i, "T").Value = ""
Else
Cells(i, "T").Value = Val(Cells(i, "T").Value)
Cells(i, "U").Value = Val(Cells(i, "U").Value)
Cells(i, "V").Value = Val(Cells(i, "V").Value)
End If
Next i
'④通貨US$、EUR、￥に修正する　USDをUS$に変更する
For i = Range("A1").End(xlDown).Row To 2 Step -1
If Cells(i, "L").Value = "USD" Then
Cells(i, "L").Value = "US$"
End If
Next i
'⑤客先HJとVのみにする
For i = Range("A1").End(xlDown).Row To 2 Step -1
If Cells(i, "B").Value <> "HJ" And Cells(i, "B").Value <> "V" Then
Cells(i, "B").Value = "V"
End If
Next i
Range("W1").Value = "カートン数"
For i = 2 To Range("A1").End(xlDown).Row
If Cells(i, "V").Value <> 0 Then
Cells(i, "W").Value = Cells(i, "G").Value / Cells(i, "V").Value
ElseIf Cells(i, "U").Value <> 0 Then
Cells(i, "W").Value = Cells(i, "G").Value / Cells(i, "U").Value
Else
Cells(i, "W").Value = 0
End If
Next i
' ' ピボットテーブルを作成する
Set D = ActiveCell.CurrentRegion
Sheets.Add
ActiveWorkbook.PivotCaches.Add(xlDatabase, D).CreatePivotTable Range("A3")
With ActiveSheet.PivotTables(1)
.PivotFields("客先").Orientation = xlRowField
.PivotFields("入荷月").Orientation = xlColumnField
.PivotFields("カートン数").Orientation = xlDataField
End With
Range("A3").Activate
ActiveSheet.Name = "カートン数"

End Sub

No.8 ベストアンサー 回答者： moto_koukousei 回答日時： 2018/03/26 21:57

≪処理コードの後半≫

エクセルシートに１つ１つ書くよりも、【VBAの中での配列変数を対象に処理して、全部の処理が終わったら、配列変数の全体を一度にエクセルシートに写す　】方法も、処理の高速化には役立つものです。

～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～

'⑤ Forループで処理するのを、エクセルシートに１つ１つやるのではなく、VBAの配列だけで処理して、処理が終わったら、
'　　VBA配列からエクセルシートに一括して転写する。
'　　(F列のデータを２～３に分割し、各左端からの数値部分をT列U列V列に適用)　 (処理条件は注釈参照)
'　　(G列データ)/(V列データか)、(G列データ)/(V列データ)か、0を、W列に提供　（処理条件はコード参照）
sgt1 = Timer ' 処理⑤にかかるスタート時刻を記憶。処理⑤を終了後に処理時間をW4セルに表示予定
Range("T7") = "Packing1": Range("U7") = "Packing2": Range("V7") = "Packing3": Range("W7") = "カートン数"
Range("T8:W" & maxrow).Clear 'T8:Wの最終行までを初期状態にする。
keka = Range("T8:W" & maxrow) 'T8:Wの最終行までの値をVBAで使用する配列kekaに写す
zans = Range("G8:G" & maxrow) 'G8:Gの最終行までの値をVBAで使用する配列zansに写す
moto = Range("F8:F" & maxrow) 'F8:Fの最終行までの値をVBAで使用する配列zansに写す
h = UBound(moto) 'Forループに使うために、最大行数を変数hに入れておく
For i = 1 To h
PACKING = Split(moto(i, 1), "/")
hh = UBound(PACKING)
For k = 0 To hh
'(F列のデータ)からT列,U列,V列にする数値データを引き出して指定列用の配列に入れる
keka(i, k + 1 - (hh = 1) * 1) = Val(PACKING(k))
Next
'G列(受注残数量？)を(パッケージング単位量？)で除した答えをW列にする指定配列に入れる
If k = keka(i, 3) <> 0 Then
keka(i, 4) = zans(i, 1) / keka(i, 3)
ElseIf keka(i, 2) <> 0 Then
keka(i, 4) = zans(i, 1) / keka(i, 3)
Else
keka(i, 4) = 0
End If
Next
Range("T8:W" & maxrow) = keka ' VBAの配列kekaをワークシート(T8:W最大行)に転写する
Range("W4").NumberFormatLocal = "0.00_ ": Range("W4") = Timer - sgt1
'⑥　クロス集計をピボットテーブルで新シートに作り、ピボットテーブルをピボットテーブルではないテーブルに置き換える
sgt1 = Timer ' 処理⑥にかかるスタート時刻を記憶。処理⑥を終了後に処理時間を新規シートのA4セルに表示予定
ActiveWorkbook.RefreshAll
For i = 1 To 23 ' 列の項目名が空白だとピボットが使えないので、空白の場合は仮の項目名をつける
If Cells(7, i) = "" Then Cells(7, i) = "仮項目名" & i
Next
motosheetname = ActiveSheet.Name
Set Darear = Range("A7:W" & maxrow)
newSheetName = "カートン数-" & Format(Now, "hhmmss") & "-" & NYUUKA_TUKI
Sheets.Add: ActiveSheet.Name = newSheetName
ActiveWorkbook.PivotCaches.Add(xlDatabase, Darear).CreatePivotTable Range("A7")
With ActiveSheet.PivotTables(1)
.PivotFields("客先").Orientation = xlRowField
.PivotFields("入荷月").Orientation = xlColumnField
.PivotFields("カートン数").Orientation = xlDataField
End With

' ピボットテーブルは(邪魔)だから？、テーブルの値だけを貼り付けて、ピボットテーブルは削除する
Worksheets(newSheetName).Cells.Copy 'ピボットの結果シートをコピー
Worksheets(newSheetName).Range("A1").PasteSpecial Paste:=xlPasteValues

Range("A3:A4").NumberFormatLocal = "0.00_ ": Range("A4") = Timer - sgt1: Range("A3") = Timer - sgt0
Worksheets(motosheetname).Activate
Range("A3:A4").NumberFormatLocal = "0.00_ ": Range("A4") = Timer - sgt1: Range("A3") = Timer - sgt0
' "A4" ピボット集計と結果の表示に掛かった時間
' "A3" 全処理に掛かった時間

Application.Calculation = xlCalculationAutomatic

End Sub

No.7 回答者： moto_koukousei 回答日時： 2018/03/26 21:51

ピボットテーブルとしての機能をその後も使用するのではないから、表は結果としてだけ残して、ピボットテーブル自体を削除するという方法での、処理の例です。

≪コードの前半だけ≫　後半は、また次回

～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～

Sub 処理例サンプルコード()
' 8行目から実質約3万行のシートを処理して、S列～W列に何かの結果をだす＋L列の｢USD｣を｢US$｣に置き換える
' 質問に貼り付いていた画像のM列～R列のデータは(なぜだか？)使用しない

' 処理時間短縮のために、（削除する行：C列データがVで始まる行）を最初に削除する
' (処理時間を短縮するために、ワークシートをVBAで操作する回数を減らす)ために
'　(Forループで1回づつやる)のできる限り減らし、一括してブロック処理する
' オートフィルで対象を絞り込んで、(その絞り込んだ行)に一括して処理する
' 個別処理は、ワークシートのセルに対して行わず、VBAの配列データに個別処理して、全部の処理が終了してから
' VBAの配列データを一括して、ワークシートに写し込む

'　本職がコードを作成するときは、可読性や改変、自分のイージーミス対策として、
'　Option Explicit　や　変数の宣言(Dim)をきちんとするし、途中のコメントも残すが、、
'　私は素人で複雑な処理コードを書かないので、基本は変数を宣言せずに使っている　
'　変数を定義せずに・variantで使い続けると、オーバーヘッドが頻繁に発生するが
'　VBAの実行が遅くなっで困ったことはないので、気にしていません。
'　特別のとき以外には、asでデータ型を定義することはないです（いかにも素人）

Application.Calculation = xlCalculationManual
'　↑　これをなくすと、処理時間が数百倍になってしまうのならば、
'　　　このBOOKの他のシートに関数など処理時間がかかるものが多量にあることが疑われる。

'　キーdボードから、[201803]のような年月を示す数字列を受ける
myMsg = "現在の年月を入力して下さい。例）2018年2月4日→【201802】と入力"
myTitle = "入荷月の修正": defa = Year(Now) & Right("0" & Month(Now), 2)
Dim NYUUKA_TUKI As String ' 文字列であると指定することに、有用性はないと私は思っている。
NYUUKA_TUKI = Application.InputBox(prompt:=myMsg, Title:=defa, Default:=201803, Type:=2)

sgt0 = Timer ' 本処理のスタート開示時刻を記憶。
' 最後に、総処理時間(秒)を計算し、　ピボットテーブル表示のためのシートのA3セルに表示する予定

With ActiveSheet.UsedRange ' アクティブシートの使用している最終行No.を確認
maxrow = .Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
End With '　使用最終行がB列,C列,C列などの最終行とは限らないが、今回はチェックしない。
Range("T8:W" & maxrow).Clear 'T8:Wの最終行までを初期状態にする。　実際は無用な処理のはず

'①（C列データがVで始まる行）を最初に削除する
sgt1 = Timer ' 処理①にかかるスタート時刻を記憶。処理①終了後に処理時間をC4セルに表示予定
Range("A8:W" & maxrow).AutoFilter '　オートフィルターを使用開始
Range("C8:C" & maxrow).AutoFilter Field:=1, Criteria1:="V*"
' c列を１とし1番目のフィールド(C列のセル)の値が"V"で始まる行をオートフィルター
Set myRng = ActiveSheet.AutoFilter.Range
myR = myRng.Rows.Count
On Error Resume Next
Rows("8:" & myR + 7).SpecialCells(xlCellTypeVisible).Delete '　オートフィルター状態での表示行を削除
On Error GoTo 0
Range("C8").AutoFilter '　オートフィルター状態を解除
maxrow = Cells(maxrow, 3).End(xlUp).Row ' 行削除したので、アクティブシートの使用している最終行No.を確認
Range("C4").NumberFormatLocal = "0.00_ ": Range("C4") = Timer - sgt1
'② (L列建値区分データ)のうち、USD を⇒ US$ と変更。　
sgt1 = Timer ' 処理②にかかるスタート時刻を記憶。処理②終了後に処理時間をL4セルに表示予定
Range("A7:W" & maxrow).AutoFilter '　オートフィルターを使用開始
Range("A7:W" & maxrow).AutoFilter Field:=12, Criteria1:="USD"
' A列を１とし12番目のフィールド(L列)が"USD"のをオートフィルター
Range("L8:L" & maxrow) = "US$" '　オートフィルター状態での表示行のL列に、"US$"を代入
ActiveSheet.ShowAllData '　オートフィルター状態で、全データ表示に戻す
Range("L4").NumberFormatLocal = "0.00_ ": Range("L4") = Timer - sgt1
'③ (B列客先データ)のうち、HJ以外の客先 を⇒ V と変更、（②と同様だが、(USD)を変更　、(HJ以外)を変更）
sgt1 = Timer ' 処理③にかかるスタート時刻を記憶。処理③終了後に処理時間をB4セルに表示予定
Range("A7:W" & maxrow).AutoFilter Field:=2, Criteria1:="<>HJ" ', Operator:=xlFilterValues
' A列を１とし2番目のフィールド(B列)が"HJ"以外のをオートフィルター
Range("B8:B" & maxrow).Value = "V" '　オートフィルター状態での表示セルに、"V"を代入
ActiveSheet.ShowAllData
Range("B4").NumberFormatLocal = "0.00_ ": Range("B4") = Timer - sgt1
'④-1 (H列の[20180206]のような数値・数字列)の内 　(特定値を含む(より小さい))の行のS列に、ある値を適用
sgt1 = Timer ' 処理④-1にかかるスタート時刻を記憶。処理④-1と④-2を終了後に処理時間をS4セルに表示予定
Range("s:s").NumberFormatLocal = "G/標準" ' この範囲を標準扱いに(関数式を入れる準備)
filC = "<=" & NYUUKA_TUKI & "31" ' オートフィルターで指定月の最大31(28,29,30,31)数以下を指定するため
ActiveSheet.Range("A7:W" & maxrow).AutoFilter Field:=8, Criteria1:=filC
Range("S8:S" & maxrow) = NYUUKA_TUKI '　オートフィルター状態での表示セルに、NYUUKA_TUKIの値を代入
ActiveSheet.ShowAllData
'④-2 S列に④-1を適用しなかった行、S列のセルが空白の行　に
'(H列の[20180206]のような数値あるいは数字列)の上位・左から6桁分を、S列に適用
ActiveSheet.Range("A7:W" & maxrow).AutoFilter Field:=19, Criteria1:="="
' オートフィルター状態での表示セルを　S列のセルが空白の行　にする
Range("S8:S" & maxrow).FormulaR1C1 = "=LEFT(RC[-11],6)" ' その行に、関数式を入れる
Range("S7").AutoFilter
Range("S8:S" & maxrow) = Range("S8:S" & maxrow).Value ' 関数式を、関数式の結果の値に置き換える
' 　 ☆☆　これをオートフィルター状態のままやると、おかしな結果になる　☆☆　
Range("S8:S" & maxrow).NumberFormatLocal = "@" ' この範囲を文字列扱いに
Range("S4").NumberFormatLocal = "0.00_ ": Range("S4") = Timer - sgt1

No.6 回答者： moto_koukousei 回答日時： 2018/03/26 21:36

処理を何度も繰り返すと、だんだん処理時間が長くなるというのは、何が原因なのかわかりません。

ピボットテーブルを作ったままそのシートを残して、また新たにピボットテーブルを新たに作るということをすると、変なことが起きるのかもしれません。（わかりません）
ピボットテーブルとしての機能をその後も使用するのではないのなら、表は結果としてだけ残して、ピボットテーブル自体を削除するという方法もあるかもしれません。

なお、試しに、新たなBOOKで、仮のデータを作成し、その仮のデータを処理してみてはどうでしょうか。

文字量の制約があるので、この回答では、仮のデータ作成のコードだけを例示します。
つぎの回答で、仮のデーターを処理するコードを例示します。

あくまで例ですが、仮に新しいBOOKを開いて、
下記の【テスト用のデータ作成()】で約3万行の仮データーを作る。　10秒以下で完成
次回回答のコードで、仮データを処理します。　　　　　　　　　　　5秒以下で完了

～～～～～～～～～～～～～～～～～～～～～～～～～～
Sub テスト用のデータ作成()
' 環境によって完了までの時間は大きく違う。たぶん1分以内。
' それぞれの列のデータを生成した秒数⇒6行目。A6⇒全体の処理時間(秒)を表示。
' 下の【Application.Calculation = xlCalculationManual】を書いてあれば、
'　別シートに20万セルにはやっやっこしい関数式がある状態でも
'　私の使用環境で【テスト用のデータ作成()】で3万行の作成には5秒はかからない
sgt0 = Timer
Application.Calculation = xlCalculationManual
'　↑　これをなくすと、処理時間が数百倍になってしまうのならば、
'　　　他のシートに関数など処理時間がかかるものが多量にあることが疑われる。
Randomize
Cells.Select
With Selection.Font ' 画面上でなるべく多くの範囲が表示できるようにするための処理
.Name = "ＭＳ Ｐゴシック"
.Size = 11: .Bold = True
End With
Cells.ClearContents
Columns("A:W").ColumnWidth = 4: Columns("C:C").ColumnWidth = 8
Columns("F:F").ColumnWidth = 11.5: Columns("H:H").ColumnWidth = 9
Columns("G:G").ColumnWidth = 7: Columns("S:S").ColumnWidth = 6
For i = 1 To 23 ' Column　の記号と　数値の対応を見易く
Cells(1, i) = i
Next
saigo = 30001 + Int(800 * Rnd()) ' 30100行目～30800行目までのどこかまでのデータを仮に作る
sgt1 = Timer '客先データ作成
Range("B8:B" & saigo).FormulaR1C1 = "=CHOOSE(RANDBETWEEN(1,6),""HJ"",""V"",""GR"",""HA"",""V3"",""HJT"")"
Range("B8:B" & saigo).Value = Range("B8:B" & saigo).Value
sgt2 = Timer
Cells(6, 2) = sgt2 - sgt1: Cells(6, 2).NumberFormatLocal = "0.00_ "

sgt1 = Timer '発注種別データ作成
Range("C8:C" & saigo).FormulaR1C1 = "=CHOOSE(RANDBETWEEN(1,9),""Hm"",""F"",""K"",""GR"",""V"",""S"" ,""Vn"",""GP"",""AA"")& randbetween(5035,42897)"
Range("C8:C" & saigo).Value = Range("C8:C" & saigo).Value
sgt2 = Timer
Cells(6, 3) = sgt2 - sgt1: Cells(6, 3).NumberFormatLocal = "0.00_ "

sgt1 = Timer 'Packingデータ作成
Range("F8:F" & saigo).FormulaR1C1 = "=CHOOSE(RANDBETWEEN(1,9),""6P/72P"",""3D/12D"",""2D/24D"",""6P/60P"",""2P/16D/36O"",""200PC/400PC"",""6PC/36PC"",""2D/24D"",""6P/72P"")"
Range("F8:F" & saigo).Value = Range("F8:F" & saigo).Value
sgt2 = Timer
Cells(6, 6) = sgt2 - sgt1: Cells(6, 6).NumberFormatLocal = "0.00_ "

sgt1 = Timer '受注残数データ作成
Range("G8:G" & saigo).FormulaR1C1 = "=RANDBETWEEN(1,800)*10 + if(rand()<0.22,5,0)"
sgt2 = Timer
Range("G8:G" & saigo).Value = Range("G8:G" & saigo).Value
sgt2 = Timer
Cells(6, 7) = sgt2 - sgt1: Cells(6, 7).NumberFormatLocal = "0.00_ "

sgt1 = Timer '入出荷日データ作成
Range("H8:I" & saigo).NumberFormatLocal = "G/標準"
Range("I8:I" & saigo).Formula = "=randbetween(41700,43800)"
Range("H8:H" & saigo).Formula = "=year(rc[1]) & right(""0"" & month(rc[1]),2) & right(""0"" & day(rc[1]),2)"
Range("H8:H" & saigo) = Range("H8:H" & saigo).Value
Range("I8:I" & saigo).ClearContents
Range("H8:H" & saigo).NumberFormatLocal = "@"
sgt2 = Timer
Range("H8:H" & saigo).Value = Range("H8:H" & saigo).Value
sgt2 = Timer
Cells(6, 8) = sgt2 - sgt1: Cells(6, 8).NumberFormatLocal = "0.00_ "

sgt1 = Timer ' 建値種別データ作成
Range("L8:L" & saigo).FormulaR1C1 = "=CHOOSE(RANDBETWEEN(1,3),""\"",""EUR"",""USD"")"
Range("L8:L" & saigo).Value = Range("L8:L" & saigo).Value
sgt2 = Timer
Cells(6, 12) = sgt2 - sgt1: Cells(6, 12).NumberFormatLocal = "0.00_ "
Cells(7, 2) = "客先": Cells(7, 3) = "発注C": Cells(7, 5) = "色略": Cells(7, 6) = "HEADER"
Cells(7, 7) = "受注残数量": Cells(7, 8) = "入出荷日": Cells(7, 12) = "建値": Cells(7, 19) = "入荷月"
Cells(6, 1) = Timer - sgt0
Application.Calculation = xlCalculationAutomatic
End Sub

～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～～

No.5 回答者： moto_koukousei 回答日時： 2018/03/26 21:26

①　いろいろ一度に詰め込んでしまっているので、もう一度、わけて作り直してみようと思います。

⇒　その結果はどうなっていますか？　スピードは改善されましたか？

②　貼り付けているデータは、毎回3000行程度です。カートン数のシートは、1つだけ作られている

⇒　そのBOOKに他のシートがあって、その別のシートに計算式の入ったセルが膨大にあると、エクセルが｢自動再計算｣を開始すると、カートン数のシートだけで処理していても、結果としての処理時間は極端に長くなることがあります。
一度、カートン数のシートしかないBOOKを作って、それでマクロを実行して、処理時間を確認されたらいいと思います。

③　貼り付けているデータは、毎回3000行程度です。5分でも遅いのですね。

⇒　パソコン搭載メモリやパソコンの性能にもよると思いますが、他のシートの数千セルに関数が入っているという程度で、3000行のデーターを質問のコードをやるの程度なら、5分間も掛かるのは掛かりすぎだと思います。
念のため、つぎの方法で確認してください。
Application.Calculation = xlCalculationManual　　　　　一番先頭に書く
Application.Calculation = xlCalculationAutomatic　　　一番末尾に書く
これでも、1分以上掛かるのなら、おかしいです。
もしも可能ならば、一度EXCELをアンインストールして、再起動し、改めてEXCELを再インストールしてみることをお勧めします。
なお、②に書いた他のシートに関数がたくさんあると、処理時間が異常に長くなるということを実際に確認することもできます。
新しいbookを開いて、Sheet1に、つぎのコードで、膨大な関数を入れてください。
Sub 関数入力()
Randomize
Range("C8:G70007").FormulaR1C1 = _
"=CHOOSE(RANDBETWEEN(1,9),""Hm"",""F"",""K"",""GR"",""V"",""S"" ,""Vn"",""GP"",""AA"")& randbetween(5035,42897)"
End Sub
つぎに、Sheet2に、つぎのコードで、処理させてください。
Sub 処理速度比較()
sgt1 = Timer
For i = 5 To 14: For j = 1 To 5
Cells(i, j) = "12345"
Next: Next
Cells(3, 1) = Timer - sgt1: Cells(3, 1).NumberFormatLocal = "0.00_ "
Application.Calculation = xlCalculationManual
sgt1 = Timer
For i = 5 To 14: For j = 7 To 11
Cells(i, j) = "12345"
Next: Next
Cells(3, 7) = Timer - sgt1: Cells(3, 7).NumberFormatLocal = "0.00_ "
Application.Calculation = xlCalculationAutomatic
End Sub

④　（処理を速くする工夫の例）
④-1　結果として無用のところは処理しないことが大事です。
行を削除するような処理をするならできるだけ早期に削除して、処理対象を減らす。
④-2　同じセルを何度も書き換えるのは無駄です。最終結果だけを書き込む。
T列、U列、V列に書いてから、書き直すのではなく、最初から結果を書く方が速いです。
④-3　3000行程度であっても、Forループで1行づつ書き込むのだと、3000回の書き込みになります。
Range("C8:G70007")="AbcDef"　　このような書き方をすると、7万行を一度で書き込めて速いです。
Ifの条件で書き込む対象を識別するような場合でも、その条件をオートフィルターで選べるように工夫すると、IF文を使わずに書き込み対象を選んで、一度で書き込むことができます。　USD⇒US$などの場合でも、(先頭にVのあるの)を選ぶ場合でも、(HJではないの)選ぶ場合でも、こうした方法を利用できます。　工夫すること自体が面倒ですから、Forループなどで処理してもいいのですが、処理時間が長くなって困るなら、工夫はした方がいいです。

この回答へのお礼

①　いろいろ一度に詰め込んでしまっているので、もう一度、わけて作り直してみようと思います。
⇒　その結果はどうなっていますか？　スピードは改善されましたか？

WindFallerさんのアドバイスを元に、分けて作り直してみたところ2分程で終了するようになりました。けれどまだ遅い箇所があるので、改善が必要なようです。

③　貼り付けているデータは、毎回3000行程度です。5分でも遅いのですね。
⇒　 念のため、つぎの方法で確認してください。
Application.Calculation = xlCalculationManual　　　　　一番先頭に書く
Application.Calculation = xlCalculationAutomatic　　　一番末尾に書く
分けて作り直してみたマクロに上記を入れて実行してみましたが、時間は変わりませんでした。
時間があるとき、元のマクロでも実行してみようと思います。

たくさんご回答頂きありがとうございます。
今、仕事が立て込んでいるので、時間が取れたとき頂いた方法を試します。
結果後ほど報告します（すぐに試せず申し訳ないです）。
お忙しいところ、いろいろアドバイスして頂き、本当に有難うございます。

お礼日時：2018/03/30 11:17

No.4 回答者： WindFaller 回答日時： 2018/03/26 11:06

まず、問題点から

Columns("S").NumberFormatLocal = "@"

これは、文字列にするために使っているのですが、基本的にはVBAでは使ってはいけません。そこを参照したりすると、書式リンクしてしまいます。まして、列を全部、書式設定するということは仮想領域を実体化させてしまいますので、手のほどこしようがなくなります。
事実上、このやり方は使えないと思ってください。

その代わりに、prefix Char の「'」書式文字列を利用します。
単に、必要に応じて、Range("A1").Value = "'" & Range("A1").Value
とするだけのことです。

仮に、一般の書式設定するときでも、End(xlUp) で、必要範囲を設定するようにしてください。ただし、例外として、メモリに負担を掛けない書式設定は、Cells を指定したときに限ります。

　 Cells(i, "C").EntireRow.Delete

この使い方も関心しません。その都度、行を削除するよりも、Union などで、削除する列をまとめておいて一括で行うべきです。

　 If Cells(i, "L").Value = "USD" Then
　　　 Cells(i, "L").Value = "US$"
　 End If

ここは、Replace で行えば一括して行えます。

それから、Pivot は、もともと組み込みマクロといって、マクロがあらかじめ埋め込まれた状態のものですから、できれば、ご自分で作られたほうが負担は減ります。もしくは、データとのリンクを切るように、値コピーしてしまうと、より軽くなります。

今は、Excelの内部メモリを計測するコマンドがありませんから、タスクマネージャーあたりで、使用中のメモリ増加を監視するぐらいしか手がないのではないでしょうか。

この回答へのお礼

ご回答ありがとうございます。
教えていただいた項目を修正しました。
わけて作り直してみたのですが、処理時間が2分程になりました。
どれもVBAの本やネットで調べてもわからないものばかりで大変勉強になりました。
有難うございました。

お礼日時：2018/03/30 11:05

No.3 回答者： moto_koukousei 回答日時： 2018/03/20 20:27

私も詳しい訳ではないので、間違っているかもしれません。

１）初めの頃は、5分程で処理が完了していたのです
⇒　どれだけデータがあるのか、パソコンのメモリがどれだけ少ないのか、などがわかりませんが、書かれたコードでそんな時間がかかるとは信じられません。　コードそのものが無駄としか思えない処理をするようになっていると思えますが、数万行あったにしても、異常な時間に思えます。
また、どうやら元データのあるVBAで処理しているシートには関数はほとんどないようですので、自動再計算で時間がかかっているのでもなさそうです。シートの書き換え処理のたびに表示しているのを止めれば、時間の節約になるかもしれません。
Application.ScreenUpdating = False
　これを【Sub 月別発注データ作成()】のつぎに入れる
Application.ScreenUpdating = True
　これを【End Sub】の前に入れる

２）今では40分程かかるようになってしまいました。固まってしまうこともあります。
⇒　毎回ピボットテーブルを新しくActiveSheet.Name = "カートン数"で作っているみたいですから、シート数がむちゃくちゃ増えているのではないと思います。そうなると、元データの行数が増加しても、基本的には、以前とほぼ同じ程度の時間で処理は終わるはずです。
固まるなんて、全くわかりません。

３）'④通貨US$、EUR、￥に修正する　USDをUS$に変更する
⇒　やっている内容と違うように思います。

⇒　全体に、どうしてそういうような手順でやるのか？と思えることがあります。
　　かなり無駄なので、手順を見直すことでも、全体の処理時間は短くなると思います。
　　しかし、画面表示の問題を別にすれば、手順の問題で5分もかかるとは思えません。

この回答へのお礼

Application.ScreenUpdating = False
Application.ScreenUpdating = True
は、入れてあるのですが（UPする時、行数の関係で削除してしまいました）状況は良くないです。
カートン数のシートは、1つだけ作られているので、それが原因では、ないような気がします。
貼り付けているデータは、毎回3000行程度です。
5分でも遅いのですね。
いろいろ一度に詰め込んでしまっているので、もう一度、わけて作り直してみようと思います。
ご回答ありがとうございました。

お礼日時：2018/03/22 13:22

No.2 回答者： t_fumiaki 回答日時： 2018/03/20 11:40

入力シート、または、出力シート内に、かつてシェイプ(図形)が在った事が有りませんか？

数個の図形だけだとしても、コピーを繰り返すと、どんどん増殖します。

一度シェイプの全削除をして見て下さい。

For Each oShape In ActiveSheet.Shapes
oShape.Delete
Next

No.1 回答者： あつしノリノリ 回答日時： 2018/03/20 11:06

パソコンを初期化するしかないと思います。

この回答へのお礼

新しいPCで実行しても同じ現象です。
やはりコードがおかしいのかと思うのですが。

お礼日時：2018/03/20 14:28