行が非表示になる原因が不明

Question

前提・実現したいこと

何度か繰り返し処理を行っていると、ランダムで行が非表示になり、正しく値が取得できません。
エクセルとパソコンの再起動を行いましたが、変化ありませんでした。
もし原因に心当たりがあれば教えていただきたいです･･･

該当のソースコード

Sub フォルダ内のファイルを出力3()

Application.Calculation = xlCalculationManual
Application.EnableEvents = False

  read_folder = Range("A2")
  read_row = Range("B2")
  read_col = Range("C2")
  read_file = Dir(read_folder & "\")

  Dim i As Long, j As Integer, read_file_str As String
  
  
  
'①14行目以降を空欄にし、セルの色をクリアにする
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets(1)

  i = read_row
  Do While ws.Cells(i, 1) <> ""
  'Do While ws.Cells(i, 1).Value <> ""
    ws.Activate
    Range(Cells(i, 1), Cells(i, 14)) = ""
    Range(Cells(i, 1), Cells(i, 14)).Interior.ColorIndex = 0
  i = i + 1
  Loop
  
  
 Application.Calculation = xlCalculationManual
 Application.EnableEvents = False
'②コピー元ファイルがなくなるまで繰り返す
Do While read_file <> ""
  Application.DisplayAlerts = False
  read_file_str = read_file

  'コピー元ファイルを展開
  Workbooks.Open read_folder & "\" & read_file
  input_end_row = Range("B65536").End(xlUp).Row
 
  'ファイルの中にデータがある場合のみかの動作を実行する
  If Range("B" & read_row) <> "" Then
    'コピー元ファイルのデータをコピー
    Range(Cells(read_row, 1), Cells(input_end_row, read_col)).Copy
    
    'コピー元ファイルを閉じる
    Workbooks(read_file).Close
    read_file = Dir()

    '集計ファイルにペースト
    output_end_row = Sheets("交換品集荷先住所").Range("B65536").End(xlUp).Row
    ThisWorkbook.Sheets("交換品集荷先住所").Activate
    Range("A" & output_end_row + 1).Select
    ActiveSheet.Paste
    
    'ファイル名の記載
    Range("N" & output_end_row + 1) = read_file_str
    
  Else
   '空白のファイルの場合、コピー元ファイルを閉じる
    Workbooks(read_file).Close
    read_file = Dir()

  End If
Loop
  Application.DisplayAlerts = True
  
  
'③A列に連番を振る
  Dim 指定行, 連番
  指定行 = read_row
  連番 = 1
  output_end_row = Sheets("交換品集荷先住所").Range("B65536").End(xlUp).Row
  
   For i = 指定行 To output_end_row
    Cells(i, 1).Value = 連番
    連番 = 連番 + 1
   Next
  
  
  
'④色つきセルの有無確認

    Dim r As Range, Row As Long
    i = 0
    Set r = Range("B14:L" & output_end_row) 'チェックする範囲を指定
    Set C = Range("L10") '条件色セルを指定
    
    For y = 1 To r.Columns.Count
        For x = 1 To r.Rows.Count
            Row = 13 + x
            If r(x, y).DisplayFormat.Interior.ColorIndex = 44 Then
            Range("M" & Row).Value = "○"
            i = i + 1
            Else
            End If
            Row = Row + 1
        Next x
    Next y
    MsgBox ("エラーは" & i & "件です")
    Range("M10") = i
    
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub

試したこと

ステップインでは問題ありませんでした

Answer 1

何度か繰り返し処理を行っていると、ランダムで行が非表示になり、正しく値が取得できません。
エクセルとパソコンの再起動を行いましたが、変化ありませんでした。
もし原因に心当たりがあれば教えていただきたいです･･･
ステップインでは問題ありませんでした

何もしないのに行が非表示になることは考えにくいです。
万が一、行が非表示になったところで、
ただしく値がコピーできないというのも考えにくいです。
ステップインで問題なければ、
単にマシンのパワーが貧弱で、
画面の表示が上手く更新されてないのではないかと推測しますが、
いかがでしょうか？

1回名前を付けて保存してから閉じて、
再度開きなおしたらどうなりますか？

あと、もしかしてだけど、
プログラムの最後に
Application.ScreenUpdating = True
と呪文を書いて改善しますか？

それでだめなら、だめもとで、、、

DoEvents
Application.ScreenUpdating = True

と、、、、
で、だめなら、
DoEvents
DoEvents
Application.ScreenUpdating = True
とか、
DoEvents
DoEvents
Application.ScreenUpdating = True
Application.ScreenUpdating = True
ここまでやってだめなら、
違うアプローチが必要かな＾＾；
とにかく思いつく限りを試すしかないかと。。。

最初から画面の更新をとめるとか、
http://officetanaka.net/excel/vba/speed/s1.htm

あとは、Sleep関数でちょっと処理を待ってあげるとかかかな。。。
http://officetanaka.net/excel/vba/tips/tips116.htm

この辺を参考に、
http://officetanaka.net/excel/vba/speed/

あ、コードについてはほぼ読んでません＾＾；
ステップ実行で問題ないなら、コードに問題はないなら、
VBAの命令が矢継ぎ早にくるので処理が間に合ってないのかなぁと思います。
時間がないのでこの辺ですみません。

あぁ、こつとしは、
http://home.att.ne.jp/zeta/gen/excel/c03p06.htm
↑この辺を参考に、
機能を別々に作って、あとで、その機能を呼び出してあげるようにする。
で、どこで問題が出るのかを根気強く試し、切り分ける。
といいと思います。
う～ん。なかなか言葉でうまく説明できないな＾＾；

Comments

[yumeno]

sleep関数を使用したところうまくいきました！馬力の問題なのでしょうか。。。
大変助かりました、ありがとうございます！