テーブルの可視セルの指定列の値がすべて同じかどうか確認したいが・・・SpecialCells(xlCellTypeVisible)で設定したRangeをFor文で回すと非表示セルの値が返ってくる

Question

環境

• Windows10 x64
• Microsoft 365

やりたいこと

可視範囲を帳票テンプレをコピーしたものに貼付け、新しい書類として帳票を作成したい。作成する前に、フィルタ―範囲の内の指定列がすべて同じ値がどうか確認したい

問題

https://www.relief.jp/docs/excel-vba-for-each-loop-visible-cells.html

こちらを参考に可視列をループして、一つでも一致しないものが見つかればBooleanのflag(変数名flg)を立てて、条件処理を行いたいのですが、
可視セルをループさせて確認処理する際、

• Set yard_rng = .ListColumns(2).DataBodyRange.SpecialCells(xlCellTypeVisible)

こちらのRangeの長さ(Count)は絞り込まれたデータ数通り

• ループ内でValueを確認してみると、最初のItem(1).Valueは可視セルの最初の値、以降のItem(i).Valueは可視/不可視に関わらず最初の可視セルの次からの値になります
• 可視範囲のコピーは問題なくできます

ソースコード

Sub Sample()
    Dim dTop As String
    Dim ws_temp As Worksheet
    Dim Count, yard_rows As Long
    Dim yard_rng, rng As Range
    Dim flg As Boolean
    flg = True
    
    dTop = Environ("UserProfile") & "\Desktop\"
    Set ws_temp = ThisWorkbook.Worksheets("Template")
    With Worksheets("Sheet1").ListObjects(1)
        Count = WorksheetFunction.Subtotal(3, .ListColumns(1).DataBodyRange)
        If Count = 0 Then
            MsgBox "該当データがありません", vbCritical, "プログラムを終了します"
            Exit Sub
        End If
        
        Set yard_rng = .ListColumns(2).DataBodyRange.SpecialCells(xlCellTypeVisible)
        yard_rows = yard_rng.Cells.Count
'        Debug.Print yard_rows
        
        If yard_rows > 1 Then
            
            Debug.Print yard_rng.Item(1).Value
            For i = 2 To yard_rows
                Debug.Print yard_rng.Item(i).Value
                If yard_rng.Item(i).Value <> yard_rng.Item(i - 1).Value Then flg = False
            Next i
            Debug.Print flg
　　　　　　'flgのTrue or Falseに基づき条件処理
　　　　　　・・・・・・
            Exit Sub
        End If
        
'この後、テンプレシートを複製し、可視範囲を張り付けていきます。

End Sub

###対策は？
一度コピぺして、その値を検証した後不要であれば削除する、というので可能だと思うのですが、現行の方法で何がダメなのか、何を加えればいいのかよく分かりません。どなたかご教示いただけないでしょうか？

試したこと

1. Set yard_rng = .ListColumns(2).DataBodyRange.SpecialCells(xlCellTypeVisible).Resize(.Rows.Count - 1)→エラー
2. コピペして貼り付け先の値で確認→〇
3. For Eachを使う→〇

        yard = yard_rng.Item(1).Value
        For Each rng In yard_rng
            If rng.Value <> yard Then flg = False
            yard = rng.Value
        Next rng

Answer 1

非連続な複数のAreaの場合には、各Areaごとに処理を回せば大丈夫な気がします。

    Dim yard_rng As Range, rng As Range
    Dim flg As Boolean
    Dim i, j, yard 

    
    yard = yard_rng.Item(1).Value
    For i = 1 To yard_rng.Areas.Count
        For j = 1 To yard_rng.Areas(i).Count
            If yard_rng.Areas(i).Item(j).Value <> yard Then flg = False
        Next j
    Next i

ただ、そこまでするならForEachでいいじゃない、という気もします。

Comments

[退会済みユーザー]

ご回答ありがとうございます。
Areaを理解するのに少々時間がかかりましたが、
yard_rng.Areas.Count
は表示行の中で隣り合っている塊の数だったので=「連続する領域」という感じでしょうか。

確かにこれでもできました！が、おっしゃる通りEachの方が簡単でスッキリするかもですね。
なぜそもそも
.SpecialCells(xlCellTypeVisible)
と絞っているRangeオブジェクトがitemやcellsでアクセスするとInvisibleなセルが含まれるのか、未だに謎です。。。

[退会済みユーザー]

開発を進めていると、２つの列の可視セルを同時にForループで参照しなくてはいけない部分がでてきたのですが、
Areaをご教示いただいたおかげで(Unionと組み合わせて)できるようになりました。
ありがとうございました。

[退会済みユーザー]

コメント削除