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

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

ただいまの
回答率

89.12%

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

解決済

回答 5

投稿 編集

  • 評価
  • クリップ 0
  • VIEW 1,074

yumeno

score 19

前提・実現したいこと

はじめまして、なんとか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

試したこと

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

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

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

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

    クリップを取り消します

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

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

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

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

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

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

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

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

    質問の評価を下げる

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

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

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

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

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

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

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

    詳細な説明はこちら

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

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

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

質問への追記・修正、ベストアンサー選択の依頼

  • papinianus

    2019/01/31 11:16

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

    キャンセル

  • yumeno

    2019/01/31 11:27

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

    キャンセル

  • ttyp03

    2019/01/31 11:46

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

    キャンセル

  • yumeno

    2019/01/31 11:58

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

    キャンセル

回答 5

checkベストアンサー

+1

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

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

イメージ説明

イメージ説明

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

投稿

編集

  • 回答の評価を上げる

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

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

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

  • 回答の評価を下げる

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

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

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

  • 2019/01/31 12:01

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

    キャンセル

  • 2019/01/31 12:28

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

    キャンセル

  • 2019/01/31 13:17

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

    キャンセル

+1

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

通常は

For y = 1 To R.Columns.Count


Next y

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

投稿

  • 回答の評価を上げる

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

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

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

  • 回答の評価を下げる

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

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

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

  • 2019/01/31 11:25

    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 でとまってしまいます・・・・

    キャンセル

  • 2019/01/31 11:31

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

    キャンセル

  • 2019/01/31 11:32

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

    キャンセル

  • 2019/01/31 11:36

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

    キャンセル

+1

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

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

投稿

  • 回答の評価を上げる

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

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

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

  • 回答の評価を下げる

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

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

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

  • 2019/01/31 12:27

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

    キャンセル

+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

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

投稿

  • 回答の評価を上げる

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

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

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

  • 回答の評価を下げる

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

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

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

  • 2019/01/31 13:16

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

    キャンセル

  • 2019/01/31 13:30

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

    キャンセル

  • 2019/01/31 15:31

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

    キャンセル

0

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

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

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

投稿

  • 回答の評価を上げる

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

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

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

  • 回答の評価を下げる

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

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

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

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

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