エラーではないようですがVBAの実行がとなります

Question

前提・実現したいこと

はじめまして、なんとかvbaを数日前から触っています。
以下、コードは問題ないように見えるのですが、実行が中断されます。なぜでしょうか･･･

発生している問題・エラーメッセージ

コードの実行が中断されました
(ハイライト箇所は以下)

VBA

Sub test()
    Dim R As Range, Row As Long
    i = 0
    Set R = Range("B14:L1000") 'チェックする範囲を指定
    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 = "○"
        Next x
        Debug.Print "xは" & x
    Next y
    Debug.Print "yは" & y
    MsgBox ("一致セル数 : " & i)
    Range("M10") = i
End Sub

試したこと

ステップインでデバックしている間は止まりません

Comments

[papinianus]

ステップインでは止まらないってことなので、とりあえず
http://unote.hatenablog.com/entries/2011/09/26 http://d.hatena.ne.jp/shouh/20160304/1457097149
にあるような、改行を入れて消したり、ブレークポイントを置いて外したりを試していただけますか？

[yumeno]

ありがとうございます。2列目(C列)に対する1回目のnextでエラーが出ているみたいでした

[ttyp03]

不要なタグVB.NETは削除してください。Excelのタグを追加してください。

[yumeno]

不要でしたか、修正しました。ありがとうございます。

Answer 1

提示のコード自体に止まる原因があるようには思えません。

一つ気になるといえば、
If R(x, y).DisplayFormat.Interior.ColorIndex = "44" Then
で、ColorIndex に数字の文字列で比較しているところ、ColorIndex は数値型のプロパティなので、
If R(x, y).DisplayFormat.Interior.ColorIndex = 44 Then
とすべきです。
ただ、暗黙の型変換が行われるのでエラーにはならないし動作も問題ないですが、気持ち悪いコードです。

新規のシートにたいして、同じコードを走らせみてください。そこで問題なければ、このコード以外に原因があると問題の切り分けができます。

あとコードの前に自動再計算抑止とイベント発生抑止のコードを追加してコードを走らせてみてください。

Sub test()
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

'中略

    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End If

これでうまくいけばいいのですが。

Comments

[yumeno]

すごいです！！！！！なぜでしょう、難解まわしても問題なくなりました！
さっきまでは解決したと思ったけどエラーが出るのでいちいち再起動しなければいけなくてこまっていました。イベント抑止コード、初めて見ました。
ポップアップを無視するコードなのでしょうか？非常に勉強になります。

[yumeno]

コードが長くなると同じ問題が発生してしまうのですね、難しい･･･

[hatena19]

シートのイベント（SelectionChange とか Change とか・・・）にプロシージャが設定されている場合、コード中でシートを編集する場合、干渉して不具合が発生するのを抑制します。ブックとかシートのイベントになにかコードを設定していませんか。
あと、下記の画面更新抑制のコードもシートを編集するようなコードの前に記述しておくと、
高速化できます。
Application.ScreenUpdating = False

Answer 2

現象は再現しませんでしたが、Excelのバグではないかという情報があります。
http://d.hatena.ne.jp/shouh/20160304/1457097149

コードを入力しなおしたらどうでしょうか？

Comments

[yumeno]

バグだったみたいです！！！！！！解決しましたありがとうございます！！！！！！

Answer 3

止まるというのを再現できませんでした・・・。

Sub test()
    Dim R As Range, Row As Long
    i = 0
    Set R = Range("B14:L1000") 'チェックする範囲を指定
    Set C = Range("L10") '条件色セルを指定
    For y = 1 To R.Columns.Count
    Row = 14
        For x = 1 To R.Rows.Count
            If R(x, y).DisplayFormat.Interior.ColorIndex = "44" Then
            'Range("M" & Row).Value = "○"
            i = i + 1
            Else
            End If
            Row = Row + 1
        Next '←ここにハイライトされます
    Next
    MsgBox ("一致セル数 : " & i)
    Range("M10") = i
End Sub

![]

・・・再現の仕方が悪かったのですかね・・・。

---

再挑戦

Sub test()
    Dim R As Range, Row As Long
    i = 0
    Set R = Range("B14:L1000") 'チェックする範囲を指定
    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 '抜けてたので追加しちゃいました
        Next x
        Debug.Print "xは" & x
    Next y
    Debug.Print "yは" & y
    MsgBox ("一致セル数 : " & i)
    Range("M10") = i
End Sub

やっぱり止まりませんでした・・・
適当に塗りつぶしてるだけだと再現できないんですかねぇ・・・。

Comments

[yumeno]

すいません・・・then以降が正しくありませんでした。デバックも加えましたので、可能であればサイド再現していただけますと幸いです・・・

[azuapricot]

あ、ありがとうございます～！

[azuapricot]

カウンタも回ってるし、数字はとれてるのですがなぜでしょう～～～～～・・・・再現できません・・・。

[yumeno]

エクセル側に何かあるんですかね･･･再起動してみます！

[azuapricot]

それかyumenoさんが実際にマクロ実行で使用している表だと状況が再現する・・・とかですかね？
とりあえずご提示のコードでは動くようです・・・。あとはエクセルのバージョンとか・・・（？）

[yumeno]

再起動したら直りました！最後までお付き合いくださりありがとうございます！！！！！再現までしてくださったので、ベストアンサーにさせていただきます

[azuapricot]

あ、よかったです～～～！再起動したら直るとかあるんですね・・・笑
うまく保存されてなかったとかでしょうか。
私も謎エラーにぶちあたったら再起動するようにします！

Answer 4

たぶんループカウンタが回ってません。

• For...Next

通常は

For y = 1 To R.Columns.Count


Next y

のようにカウンタを次のカウンタ（基本は+1）につなげます。

Comments

[yumeno]

Sub エラーカウントファンクション()
Dim R As Range, Row As Long
i = 0
Set R = Range("B14:L1000") 'チェックする範囲を指定
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 = "○"
Next x
Next y
MsgBox ("一致セル数 : " & i)
Range("M10") = i
End Sub

と改修しましたが、やはりNext　x　でとまってしまいます・・・・

[m.ts10806]

あとはデバッグですね。それぞれのループカウンタをnextの前で
Debug.Print で出力してどこで止まってるか確認してください

[m.ts10806]

それぞれのループ回数はきちんと取れてるんですよね？

[yumeno]

Debug.Printを使ってみたところ、2列目(C列)に対する1回目のnextでエラーが出ているみたいでした。うまく列移動できていないということですかね･･･

Answer 5

解決済のようですが、気になったので。。。

Ctrl + Break

の件ですが、ユーザーにとっては分かり難い挙動ですが、
バグなのか仕様なのかは、ユーザーには解りません。
なので、知っておいて対処するしかないです。
ま、こういう掲示板で聞くより、
「コードの実行が中断されました」
で検索した方が、情報は速く得られます。

それから。。。。
変数の宣言はちゃんとする癖をつけた方がいいと思います。
あと、変数を使うなら、もう少し有効に使いましょう。
それと、セルを見て行く順番も考慮して、
同じセルに何度も同じ内容を書き込まないようにした方がいいと思います。
何度もセルを読み書きするのはかなり処理速度的に不利になります。

Option Explicit

Sub test()
    Dim r As Range
    Dim Iro As Long
    Dim Cmax As Long
    Dim x As Long, y As Long
    Dim i As Long, j As Long

    Set r = Range("B14:L1000")                          'チェックする範囲を指定
    Iro = Range("L10").DisplayFormat.Interior.Color     '条件色を指定
    Cmax = r.Columns.Count

    For x = 1 To r.Rows.Count
        j = i
        For y = 1 To Cmax
            If r(x, y).DisplayFormat.Interior.Color = Iro Then i = i + 1
        Next
        If i > j Then r(x, Cmax + 1).Value = "○"
    Next

    Range("M10").Value = i
End Sub

参考までに、こんな書き方もできるかなぁ。。。

Sub test2()
    Dim Rng As Range
    Dim r As Range, c As Range
    Dim myCollar As Long
    Dim flg As Boolean
    Dim vResult() As Variant

    Set Rng = Range("B14:L1000")
    myCollar = Range("L10").DisplayFormat.Interior.Color
    ReDim vResult(1 To Rng.Rows.Count, 1 To 1)

    For Each r In Rng.Rows
        flg = False
        For Each c In r.Cells
            If c.DisplayFormat.Interior.Color = myCollar Then
                myCount = myCount + 1
                flg = True
            End If
        Next
        If flg Then v(r.Row - Rng.Row + 1) = "○"
    Next
    With Rng
        .Columns(.Columns.Count + 1).Value = vResult
    End With
End Sub

※注意
動作確認をしてません。
ちゃんと動かなかったらごめんなさいです。