[[20191101230950]]　『空白行の行飛びがあったときにメッセージをだした』（ちこ）　ページの最後に飛ぶ

『空白行の行飛びがあったときにメッセージをだしたい』（ちこ）

VBA初心者です

教えてください
B列からM列まで3行目から始まる表で
行（データ）が飛んで入力されたデータがあった場合
"行飛びデータがあります"とメッセージを出して飛んで
入力されたデータのセルに黄色の背景色をつけたいのですが
どう記述すればいいでしょうか
行数は3から83の80行です

こんな感じです
　A　B　C　D 　E　F
３××××××××
４△△△△△△△△
５○○○○○○○○
６　　　　　　　　　←空白行の下に1つでもデータがあれば処理をしたい　　
７◎◎◎◎◎◎◎◎
８

よろしくお願いします

＜使用 Excel：Excel2016mac、使用 OS：Windows10 ＞

試してみてください。

 Sub test()
    Dim tbl As Range
    Dim r As Range

    Set tbl = Range("B3:M83")
    Set r = tbl(1).CurrentRegion

    Set r = Intersect(tbl, r.Offset(r.Rows.Count))
    If r Is Nothing Then Exit Sub

    Set r = r.SpecialCells(xlCellTypeConstants)
    If Not r Is Nothing Then r.Select

 End Sub

（マナ） 2019/11/02(土) 08:47

 ＞"行飛びデータがあります"とメッセージを出して

 これはいいのですが、どのタイミングで出したいのでしょう？

 ＞入力されたデータのセルに黄色

 入力されていない行の誤りですか？

（渡辺ひかる） 2019/11/02(土) 08:49

横からですがちょっと確認。
＞B列からM列まで3行目から始まる表
なので↓こんな感じだとおもうのですが

   __B_____C_____D_____E_____.._M__
 ３ ××  ××  ××  ××     ××
 ４ △△  △△        △△     △△
 ５ ○○  ○○  ○○  ○○     ○○
 ６
 ７ ◎◎  ◎◎  ◎◎  ◎◎     ◎◎
 ８

このとき、「"行飛びデータがあります"とメッセージを出して」
ということなので、1行そっくり抜けている場合のみメッセージを出すという理解でよいですか？
（私が提示したもので言うと、D4が抜けているけどセーフ扱いでよいのか）

（もこな２） 2019/11/02(土) 09:30

みなさま

メッセージとセルへの色つけのタイミングはマクロを走らせたときです

行飛びの飛んでいない上部の方はB列からM列まではすべて入力されていて抜けはありません
逆に行飛び後のデータはデーターセルの数に限らず1つ以上のセルにデータがあったら処理をします

よろしくお願いします
（ちこ） 2019/11/02(土) 15:31

たぶんマナさんの解釈で良いと思うのですが、A列が埋まっていたり、いろいろ考慮すると、
動作がおかしくなるので、１行づつチェックしてみました。

Sub test()

    Dim r As Range, rr As Range, r1 As Range, r2 As Range
    Dim flg As Boolean
    With Range("B3:M83")
        .Interior.Pattern = xlNone
        .Cells(1).Select
        Set r = .Find("*", .Cells(1), , , xlByRows, xlPrevious) '81行くらいなら全てLoopしても良いが、最終行取得
                                                                '行数は3から83は81行です
        If r Is Nothing Then
            MsgBox "There is no data at all"
            Exit Sub
        End If
        For Each r1 In .Rows("1:" & r.Row - .Row + 1)           '最終行までLoop
            Set r2 = Nothing
            On Error Resume Next                        '次行のステートメントで空白行だとエラーが出るのでエラーを無視
            Set r2 = r1.SpecialCells(xlCellTypeConstants)       '行中の記入セルを探す（空白行ならエラーでr2 = Nothingのまま）
            On Error GoTo 0
            If flg Then
                If Not r2 Is Nothing Then           'チェックフラグ有り（空白行以降）で
                    If rr Is Nothing Then               '空白行で無く
                        Set rr = r2                     '飛んで入力セルが未登録なら登録
                    Else
                        Set rr = Union(rr, r2)          '登録済みなら飛んで入力セルを連結
                    End If
                End If
            Else
                If r2 Is Nothing Then flg = True    '初回空白行ならチェックフラグ立てる
            End If
        Next
        If Not rr Is Nothing Then
            rr.Interior.Color = vbYellow
            rr.Select
            MsgBox "行飛びデータがあります"
        End If
    End With
 End Sub

（kazuo） 2019/11/03(日) 09:03

質問者さんには、無視されましたが、
明らかな間違いを放置しておくのも気になるので。

 > Set r = Intersect(tbl, r.Offset(r.Rows.Count))
                           ↓
   Set r = Intersect(tbl, tbl.Offset(r.Rows.Count))

で、ご指摘のケースも考慮するとこんな感じで。
★の行で、必ずしも、意図した通りに取得できませんが
結果的には、同じ結果になるようです。

 Sub test2()
    Dim tbl As Range
    Dim r As Range

    Set tbl = Range("B3:M83")
    Set r = tbl.SpecialCells(xlCellTypeConstants).Areas(1)  '★

    Set r = Intersect(tbl, tbl.Offset(r.Rows.Count))
    If r Is Nothing Then Exit Sub

    On Error Resume Next
    Set r = r.SpecialCells(xlCellTypeConstants)
    On Error GoTo 0
    If Not r Is Nothing Then r.Select

 End Sub

（マナ） 2019/11/03(日) 09:59

失敗。最後の、r Is Nothing　は、ありえないですね。

 ＞If Not r Is Nothing Then r.Select

（マナ） 2019/11/03(日) 10:04

 お邪魔します。。お邪魔やったら出て行って・・・まぁ、、そうおおしゃらずに(^^;関西人のノリです。。
 そんなんどうでもええから早よ回答せんかえ！おっさん、、はい！すみません。。

 えっつと、、最初から気になっていたんですけど、、↓これ？

 >行飛びの飛んでいない上部の方はB列からM列まではすべて入力されていて抜けはありません 
 >逆に行飛び後のデータはデーターセルの数に限らず1つ以上のセルにデータがあったら処理をします

 下からループして抜けがあったら抜ける(しゃれ？ではないです。）かなと、、老婆心ながら、、

 見当違いでしたら、、ゴミ箱にでもポイしてといてください。。。では、、では、、

 大筋は、、kazuo　さんのコードをお借りしました。m(__)m

 Option Explicit
Sub てすと()
Dim r As Range
Dim i As Long
Dim flgA As Boolean
Dim flgB As Boolean
Range("B3:M83").Interior.Pattern = xlNone
For i = 83 To 3 Step -1
    If Application.CountA(Range("B" & i).Resize(, 12)) > 0 Then
        flgA = True
        If r Is Nothing Then
            Set r = Range("B" & i).Resize(, 12).SpecialCells(xlCellTypeConstants)
        Else
            Set r = Union(r, Range("B" & i).Resize(, 12).SpecialCells(xlCellTypeConstants))
        End If
    Else
        If flgA Then
            flgB = True
            Exit For
        End If
    End If
Next
If flgB Then
    If Not r Is Nothing Then
        r.Interior.Color = vbYellow
        r.Select
        MsgBox "行飛びデータがあります"
    End If
End If
End Sub
（SoulMan） 2019/11/03(日) 11:52

＞タイミングはマクロを走らせたときです
そのタイミングがいつになるのかということなんですが.....
まぁ、入力した後に"別途"マクロを実行すると解釈します。

＞行飛びの飛んでいない上部の方はB列からM列まではすべて入力されていて抜けはありません
ということなので、B3～B列最終行のうち、ブランクセルがあるかどうかをチェックすればよいことになるので、↓みたいな感じでどうでしょうか？

    Sub さんぷる()
        Dim 最終行 As Long
        Dim MyRNG As Range

        '▼塗りつぶしを一旦解除
        Range("B3:M83").Interior.ColorIndex = xlNone

        '▼最終行を取得してデータが入力されているかをチェック
        最終行 = Cells(Rows.Count, "B").End(xlUp).Row
        If 最終行 < 3 Then Exit Sub

        '▼B3～B列最終行までのうちブランクセルを取得
        On Error Resume Next
        Set MyRNG = Range("B3", Cells(最終行, "B")).SpecialCells(xlCellTypeBlanks)
        On Error GoTo 0

        '▼取得されたセルがあるときだけ処理
        If Not MyRNG Is Nothing Then
            Intersect(MyRNG.EntireRow, Range("B:M")).Interior.Color = vbRed
            MsgBox "行飛びデータがあります"
        End If

    End Sub

（もこな２） 2019/11/03(日) 13:27

マナさん、kazuoさん、SoulMan、もこな２さん

大変お忙しいところご教示いただきまして

ありがとうございました。

皆様に教えていただいた素晴らしいサンプルコードを元に

作成してみたいと思います

本当にありがとうございました。
（ちこ） 2019/11/03(日) 17:54

コメント返信：

[ 一覧(最新更新順) ]

[[20191101230950]] 『空白行の行飛びがあったときにメッセージをだした』（ちこ） ページの最後に飛ぶ

[[20191101230950]]　『空白行の行飛びがあったときにメッセージをだした』（ちこ）　ページの最後に飛ぶ