質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

87.58%

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

解決済

回答 1

投稿

  • 評価
  • クリップ 1
  • VIEW 1,996

score 19

前提・実現したいこと

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

該当のソースコード

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

試したこと

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

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 1

checkベストアンサー

+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
↑この辺を参考に、
機能を別々に作って、あとで、その機能を呼び出してあげるようにする。
で、どこで問題が出るのかを根気強く試し、切り分ける。
といいと思います。
う~ん。なかなか言葉でうまく説明できないな^^;

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/02/04 15:56

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

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 87.58%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る