最近急にVBAの処理速度が遅くなりました。

こんにちは。以前こちらで横並びのデータを縦並びにしたいという質問に、VBAで解決して下さいました。
あの後順調にきていましたが、最近マクロを実行すると終わるまで15分ほどかかってしまいます。

以前教えていただいたコードはこちらです。

Sub Sample4() '//この行から
Dim i As Long, j As Long, cnt As Long, lastRow As Long, wS As Worksheet
Set wS = Worksheets("仕入表")
With Worksheets("在庫表")
'//E列で「在庫表」Sheetの最終行取得★
lastRow = .Cells(Rows.Count, "E").End(xlUp).Row
'//「在庫表」SheetにデータがあればD列2行目～I列最終行データを一旦消去
If lastRow > 1 Then
Range(.Cells(2, "D"), .Cells(lastRow, "I")).ClearContents
End If
cnt = 1
For i = 3 To wS.Cells(Rows.Count, "A").End(xlUp).Row '//「仕入表」Sheetの3行目～A列最終行まで
For j = 5 To wS.Cells(i, Columns.Count).End(xlToLeft).Column Step 2 '//E列～i行最終列まで2行毎★
If wS.Cells(i, j) <> 0 Then '//画像で「0」が表示されているので「0」以外を追加★
cnt = cnt + 1
'//最初のデータ行のみ「仕入表」Sheetの日付をD列に表示★
If j = 5 Then
.Cells(cnt, "D") = wS.Cells(i, "A")
End If
.Cells(cnt, "E") = wS.Cells(i, "B") '//B列に「コード」を表示
.Cells(cnt, "F") = wS.Cells(i, "C") '//F列に「商品名」を表示
.Cells(cnt, "G") = wS.Cells(i, "D") '//G列に「下代」を表示
.Cells(cnt, "H") = wS.Cells(i, j) '//H列に「色」を表示
.Cells(cnt, "I") = wS.Cells(i, j + 1) '//I列に「数」を表示
End If
Next j
Next i
'//最後にD列の表示形式（日付）を「在庫表」SheetのA3セルの書式に設定★
.Range("D:D").NumberFormatLocal = wS.Range("A3").NumberFormatLocal
End With
End Sub '//この行まで

補足ですが、仕入表に入力した情報を在庫表に転記させたいという質問でした。
終わりの行から続きを入力する形でよいのですが、”在庫表」SheetにデータがあればD列2行目～I列最終行データを一旦消去”という処理が遅くさせてるということはありますか？


データが何千行にもなっています。
解決策があれば教えていただきたいです。よろしくお願いします。

質問者からの補足コメント

• 

  Sub Sample4() '//この行から
  Dim i As Long, j As Long, cnt As Long, lastRow As Long, wS As Worksheet
  Application.ScreenUpdating = False
  ・
  ・
  ・
  
  End With
  Application.ScreenUpdating = True
  End Sub '//この行まで
  
  入れ方はこちらであってますか？
  これと.Range(.Cells(2, "D"), .Cells(lastRow, "I")).ClearContents
  を試しましたが変わりませんでした><
  
  ありがとうございます。

  No.1の回答に寄せられた補足コメントです。 補足日時：2017/03/10 12:04

• 

  https://oshiete.goo.ne.jp/qa/8980328.html
  
  以前の質問です。取り急ぎこちらを張り付けします。よろしくお願いします。

    補足日時：2017/03/10 13:34

• ありがとうございます。
  
  元データはA～X列までの大体1000行程度です。
  
  実行先は3000行程度までなります。列はD～Iまでです。

  No.4の回答に寄せられた補足コメントです。 補足日時：2017/03/10 13:37

• 在庫表のタブには数式は入ってませんが、元データの仕入表タブには計算式がたくさんはいってますし、同じファイルの他のタブにも沢山計算式が入ってます・。。
  それが原因でしょうか・・・

  No.5の回答に寄せられた補足コメントです。 補足日時：2017/03/10 13:46

• 

  皆さん色々なアドバイスありがとうございます！！
  とりあえず７番さんと９番さんのを実行したら一瞬でマクロが実行されました！！！！！
  ありがとうございます！！！！！！！！！！！！！！
  
  ですが、実行の後に、「実行時エラー’１３　　　型が一致しません」
  と出てきました。これは何でしょうか・・・無視しても大丈夫ですか？

  No.9の回答に寄せられた補足コメントです。 補足日時：2017/03/13 09:58

• ありがとうございます。
  教えて下ったコードを追加したらマクロが実行できずにエラーになってしまいました。。
  たいへん恐れ入りますが、最初からコードを書いていただくことはできますか・・・？

  No.10の回答に寄せられた補足コメントです。 補足日時：2017/03/15 12:15

• 

  エラー１３の表示が出たときにデバック？というボタンを押したらVBAのコードで以下の部分が黄色で色付けされていました。
  
  If wS.Cells(i, j) <> 0 Then '//画像で「0」が表示されているので「0」以外を追加★

    補足日時：2017/03/16 10:13

• 

  本当にありがとうございます。
  時間をかけてくださって感謝してます。
  
  教えていただいたコードをペーストして実行したら、「コンパイルエラー　NEXTに対するFORがありません」とでました。
  OKを押したらVBAが出てきて、
  Sub Sample4() '//この行から
  この部分が黄色になり、
  Next j
  にカーソルが入ってます。

    補足日時：2017/03/17 17:02

No.7 回答者： poco_2 回答日時： 2017/03/10 13:55

とりあえずですが

先ほどの
Application.ScreenUpdating = False
と
Application.ScreenUpdating = True
の位置に
Application.Calculation = xlCalculationManual
と
Application.Calculation = xlCalculationAutomatic
を入れるとどうなります？
（再計算を止めるコードです。）

No.6 回答者： ママチャリ 回答日時： 2017/03/10 13:50

他のシートには、式が沢山入っているとの事ですが、在庫表のD〜I列を参照している式はありますか？もしある場合、具体的にどんな式ですか

？

この回答へのお礼

在庫表のD～I列からひっぱってる計算式って事ですか？

お礼日時：2017/03/10 13:58

No.5 回答者： ママチャリ 回答日時： 2017/03/10 13:43

提示されているコードを見る限りでは、そんなに時間がかかるような箇所は見受けられないようですが、まさか、在庫表のA〜C列、または、J

列以降に重たい数式など入っていないですよね？

No.4 回答者： tatsu99 回答日時： 2017/03/10 13:29

高速化を意識して作り直したほうがよいかと。

前回の質問が判らないので、そのURLを提示していただけますか。もしくは、前回の質問の内容をご提示ください。
また、性能に影響するので、データ量に関する現在の情報を提示ください。
（最大、何行、何列あるかというような情報です）

No.3 回答者： poco_2 回答日時： 2017/03/10 13:20

失礼しました。

あまり関係ありませんでしたね。

元のデータはE列から横に色と数が並んでいるということですか？
このデータが何列目まであるかは可変？
平均して何列くらいあるのでしょう？

No.2 回答者： Zincer 回答日時： 2017/03/10 13:17

これを毎回はかなり時間のロスでは？

For i = 3 To wS.Cells(Rows.Count, "A").End(xlUp).Row '//「仕入表」Sheetの3行目～A列最終行まで
For j = 5 To wS.Cells(i, Columns.Count).End(xlToLeft).Column Step 2 '//E列～i行最終列まで2行毎

wS.Cells(Rows.Count, "A").End(xlUp).Row
も
lastRow = .Cells(Rows.Count, "E").End(xlUp).Row
のようにできませんか？
こちらは、1回しか処理していないので、それほど関係ありませんが、

wS.Cells(i, Columns.Count).End(xlToLeft).Column
は
毎回各行で行うようになっています。
各行で変わる値なのでしょうか？
変わらないようであれば、上記のように1回だけの処理にした方が良いでしょう。

No.1 回答者： poco_2 回答日時： 2017/03/10 11:45

コードの中身は読み取っていませんが、消去（ClearContents）で時間がかかることはないと思います。

見たところ動作中の画面を非表示にしていないようですのでまずはそこから。

最初の方、Dim　の宣言の次にでも
Application.ScreenUpdating = False
を入れ、
最後の　End Sub の前に
Application.ScreenUpdating = True
を入れて下さい。
これでVBA動作中の画面を非表示にします。

あ、
Range(.Cells(2, "D"), .Cells(lastRow, "I")).ClearContents
のところ、"在庫表"シートでよければ
.Range(.Cells(2, "D"), .Cells(lastRow, "I")).ClearContents
にして下さいね。
「.」が抜けてます。