[[20200717085924]] 『VBAを実行するとエクセルが固まる』(saku) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『VBAを実行するとエクセルが固まる』(saku)

シートの内容をコピーするVBAを作ったのですが、
デバックするとEXCELがかたまり、動かせなくなってしまいます。その後再起動です・・・

コードに問題があるのでしょうか。

Sub Test()

    Dim i As Long, z As Long, y As Long
    Dim sh2 As Worksheet
    Dim sh3 As Worksheet

    Application.ScreenUpdating = False

    With Sheets("全品目")

        z = .Range("L" & .Rows.Count).End(xlUp).Row
        Range("返却済").ClearContents
        Range("使用中").ClearContents

        For i = z To 3 Step -1
            If .Cells(i, "L").Value = "1" Then
                Set sh2 = Sheets("使用中")
                y = sh2.Range("B" & sh2.Rows.Count).End(xlUp).Row
                y = y + 1
                .Rows(i).Copy Destination:=sh2.Cells(y, 1)
            ElseIf .Cells(i, "L").Value = "2" Then
                Set sh3 = Sheets("返却済")
                y = sh3.Range("B" & sh2.Rows.Count).End(xlUp).Row
                y = y + 1
                .Rows(i).Copy Destination:=sh3.Cells(y, 1)
            End If
        Next

    End With

    Application.ScreenUpdating = True

       Cells(2, 14) = WorksheetFunction.CountIf(Range("B2").Select, Cells(3, 2))

 End Sub

< 使用 Excel:Excel2013、使用 OS:Windows10 >


 おはよ〜ございます ^^
ちょっと見なので、よく理解しておりませんが。このような場合良く起こるトラブル
として、
1.無限ループになっている
2.処理内容が重たく、件数が膨大
ループの中に、Doevents を入れてみて。
適当なところでブレイクかけて、
変数zの値等、原因を調べてみて下さい。
外していましたらお許しを。。。m(_ _)m
(隠居じーさん) 2020/07/17(金) 09:12

WorksheetFunction.CountIf(Range("B2").Select, Cells(3, 2))
ここが変な感じですが
(mm) 2020/07/17(金) 09:19

私も同じ悩みを持ったことがありますので気持ちはわかります。

原因は↓です。

 Application.ScreenUpdating = False

理解して書いたかわかりませんが、ここで画面の更新を停止しています。
そして、【実行時エラー】が発生したときに終了を選ぶと、

 Application.ScreenUpdating = True

が実行されないままになります。
従って、固まっているのではなく、画面の更新が行わないままになっているだけです。

対処については、エクセルの再起動でもよいですが、イミディエイトに↓を入力するだけでも大丈夫だとおもいます。

 Application.ScreenUpdating = True

(もこな2 ) 2020/07/17(金) 09:22


もし、mmさんが指摘されている部分で実行時エラーが発生しているなら、↑のコメントは無視してください。

(もこな2 ) 2020/07/17(金) 09:29


Doeventsの挿入方法はどうすればよいのでしょうか。
当方超初心者でして、検索を掛けましたが理解できませんでした...

WorksheetFunction.CountIf(Range("B2").Select, Cells(3, 2)) を削除、また
Application.ScreenUpdating = Trueをイミディエイトウィンドウに記入してデバックしましたが、また固まってしまいました。

内容としては別シートに値をコピーしているだけなのでそんなに重くなりそうにないと素人目には思うですが違うんですね。

(saku) 2020/07/17(金) 10:26


おはようございます ^^
あの〜、きっとそう重くはないのでしょう。
ちなみに処理件数は何件ですか?
あと気になる点は、セルの範囲名、返却済、使用中、
は全品目シートの中にあるのでしょうか。

(隠居じーさん) 2020/07/17(金) 10:33


Range("返却済").ClearContents
Range("使用中").ClearContents

  ↑

をけすか、コメントアウトすれば、
mmさんご指摘の箇所を削除され
たなら動かないでしょうか。
(隠居じーさん) 2020/07/17(金) 10:39


 追伸 すみません、おたづねするばかりで ^^;
DoeventsはEnd Ifとnextの間にでも、書込んでください。
(隠居じーさん) 2020/07/17(金) 10:47

Range("返却済").ClearContents
Range("使用中").ClearContents
こちらのコードは目的があり書いているのですがあってはいけないものなのでしょうか。

使用目的としては
コピー元元データが追加があった際に再度デバックをかけます。
その際に、前回書いたテーブルの下にどんどん追加で書き加えられてしまうため
毎回テーブル内容をリセットするために書いています。
(saku) 2020/07/17(金) 11:28


処理件数は30ほどです。

Range("返却済").ClearContents←これはテーブルのデータを削除するもので、
返却済テーブルは返却済シートに、使用中テーブルは使用中シートにあります
(saku) 2020/07/17(金) 11:30


 おはようございます ^^
>>こちらのコードは目的があり書いているのですがあってはいけないものなのでしょうか。 
決してそのような理由ではありません。エラー箇所を見つける為、
一時停止して、それで動けば、指定の仕方に問題があると、解り
ますので、原因究明の手立てです。^^;テーブル名、了解いた
しました。複数シート間の処理にもかかわらず、シートの指定が
されていないレンジオブジェクトが有りますので、明示的に指定
されてはどうでしょうか、その辺が原因でエラーになることもあ
り得ます。30件ですとDoevenntsを記入しなくても通常でしたら問
題ないと思います。
で
動きましたか
それとも
何処かで、まだ停止しますか。

(隠居じーさん) 2020/07/17(金) 11:57


隠居じーさん様

そういうことだったんですね。
ありがとうございました。

以下のようにテーブルのシート指定で書き直しましたが、まだ止まります...

Sub Test()

    Dim i As Long, z As Long, y As Long
    Dim sh2 As Worksheet
    Dim sh3 As Worksheet

    Application.ScreenUpdating = False

    With Sheets("全品目")

        z = .Range("L" & .Rows.Count).End(xlUp).Row

        For i = z To 3 Step -1
            If .Cells(i, "L").Value = "1" Then
                Set sh2 = Sheets("使用中")
                     Worksheets("返却済").Range("返却済").ClearContents
                y = sh2.Range("B" & sh2.Rows.Count).End(xlUp).Row
                y = y + 1
                .Rows(i).Copy Destination:=sh2.Cells(y, 1)
            ElseIf .Cells(i, "L").Value = "2" Then
                Set sh3 = Sheets("返却済")
                    Worksheets("使用中").Range("使用中").ClearContents
                y = sh3.Range("B" & sh2.Rows.Count).End(xlUp).Row
                y = y + 1
                .Rows(i).Copy Destination:=sh3.Cells(y, 1)
            End If
        Next

    End With

    Application.ScreenUpdating = True

 End Sub

(saku) 2020/07/17(金) 12:21


 こんにちは ^^
こちらでも動かして見るのですが、例のテーブル初期化の
コードを止めると、動きます、実際のテーブル名とコード
内のテーブル名は合っていますでしょうか。^^;。。
ご確認を、m(_ _)m
(隠居じーさん) 2020/07/17(金) 12:41

>デバックすると
実際には【実行時エラー】が発生して、「デバッグ」を選んだ
ということだと解釈してますが、あってますか?

あっている場合、

 (1)どの部分で発生しているか
 (2)エラー番号、エラーメッセージはなにか

ということをお伝え頂くと、アドバイスできることがあるかもしれません。

>Application.ScreenUpdating = Trueをイミディエイトウィンドウに記入してデバックしましたが、また固まってしまいました。
そうではなくて、終了を選んだり、デバッグ(プログラム修正)したあと、再開しなかったりして、

 Application.ScreenUpdating = True

が実行されないときは、別途自分で実行すれば、エクセルを再起動しなくても大丈夫だという意味です。
プログラムを修正しないならば、改善していないのですから、同じエラーが発生するのは当たり前のことですよね?

(もこな2 ) 2020/07/17(金) 12:42


 Sub Test01()
     MsgBox Worksheets("使用中").ListObjects(1).Name
     MsgBox Worksheets("返却済").ListObjects(1).Name
 End Sub

 よければ、実行して見て、確認してください。^^。。。m(_ _)m
各シート、テーブルは一つですよね。。。^^;w
(隠居じーさん) 2020/07/17(金) 12:56

隠居じーさん様

各シート、テーブル一つです。
上記のコードを実行したところ無事二つのメッセージがでてきました。

もこな2様

エラーメッセージなどは出ません。
実行した瞬間、画面が固まります。
なのでタスクマネージャーから強制終了させています。

カーソルの前まで実行を繰り返し調べたところ、end withの前までであれば固まらず実行されます。

意味が良くわかっておらず申し訳ございませんでした。
(saku) 2020/07/17(金) 13:11


え〜と、とりあえず、表示されたテーブル名を教えて下さいますか。
それと
いまでも
>>実行した瞬間、画面が固まります。
>>なのでタスクマネージャーから強制終了させています。
なのでしょうか。

(隠居じーさん) 2020/07/17(金) 13:19


テーブル名は
使用中
返却済
の二つです。

はい、当初の操作をしようとすると固まってしまいエクセル内の操作が出来なくなるため強制終了させています。。。
(saku) 2020/07/17(金) 13:37


Nextの前に、以下のようなコードを追加すると、どこまで実行しているか判るし、Breakキーによる停止もできるようになるので、試してみてください。
            If i Mod 10 = 0 Then
                Application.StatusBar = i
                DoEvents
            End If

プロシジャ終了前には、Application.StatusBar = "" とかで、表示を元に戻しましょう。
データ量が多いなら、i Mod 100 にするとか、表示間隔は調整してください。
(???) 2020/07/17(金) 13:43


>>処理件数は30ほどです。

ダミー情報で動かすと当方ではエラー「」をつぶせば
動きます。。。。EXCEL 2013 とのことなので
https://coresys.co.jp/repair_case/excel-2/
なんかでしょうかね。。。ふしぎだなぁ〜

(隠居じーさん) 2020/07/17(金) 13:52


 こんにちは ^^
Sub Test02()
    Dim i As Long, z As Long, y As Long
    Dim sh2 As Worksheet
    Dim sh3 As Worksheet
    Application.ScreenUpdating = False
    With Sheets("全品目")
        z = .Range("L" & .Rows.Count).End(xlUp).Row
        For i = z To 3 Step -1
            If .Cells(i, "L").Value = "1" Then
                Set sh2 = Sheets("使用中")
                     'Worksheets("返却済").Range("返却済").ClearContents
                y = sh2.Range("B" & sh2.Rows.Count).End(xlUp).Row
                y = y + 1
                .Rows(i).Copy Destination:=sh2.Cells(y, 1)
            ElseIf .Cells(i, "L").Value = "2" Then
                Set sh3 = Sheets("返却済")
                    'Worksheets("使用中").Range("使用中").ClearContents
                y = sh3.Range("B" & sh3.Rows.Count).End(xlUp).Row
                y = y + 1
                .Rows(i).Copy Destination:=sh3.Cells(y, 1)
            End If
        Next
    End With
    Application.ScreenUpdating = True
 End Sub
このコードで当方では問題なく動作しております。[Excel2016,win10]、それでも固まるなら
別のPCで実行しても同じことになるか調べるのは可能でしょうか。
(隠居じーさん) 2020/07/17(金) 14:32

 失礼しました ↑ では テーブルの初期化はコメントアウトになっていますが
外した状態で正常作動。。。結果は解りませんが。。。動くのは動きますです。^^;
でわでわ。。。m(_ _)m。。。これ以上は原因が思い浮かびませんので、他のお詳しい方の
回答をお待ちくださいませ。お役に立てず、あい済みません。でわ、頑張ってくださいね。
(隠居じーさん) 2020/07/17(金) 14:39

隠居じーさん様

色々と試してくださりありがとうございます!!
やはり、テーブルを消す操作が良くなさそうですので他の作戦を考えたいと思います。
ありがとうございました(^^)
(saku) 2020/07/17(金) 18:47


y = sh3.Range("B" & sh2.Rows.Count).End(xlUp).Row sakuさん
y = sh3.Range("B" & sh3.Rows.Count).End(xlUp).Row 隠居じーさんさん

(きき) 2020/07/17(金) 18:59


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.