ExcelVBAでオートフィルした結果のセルをタイトル行（見出し）を除いて取得したい

Question

オートフィル後のセル値をメッセージににオートフィル結果だけを出したい

はじめまして。ExcelVBAは今年の５月から始めました。
１５年ほど前にプログラマーだった時期がありその時はVBやVBA専門で開発していたのですが、今はほとんど忘れてしまい、復習の意味で勉強しています。

そして、業務で多いと予想される「ExcelVBAでのオートフィル操作」について勉強しているのですが分からないところがあり、ここで相談させていただきました。

オートフィル後、結果だけを取得したいのにタイトル行も取得されてしまう

現在、Excelではこのようなデータを作っています。

ここから、Aの果物で「パイナップル」「リンゴ」「みかん」をキーにフィルターをかけます。
するとこう表示されます。

その後、フィルターした結果のC列から担当者名をメッセージボックスで表示させたいです。
つまり、この場合は動かすと、

ループ１回目　→　「山田」
ループ２回目　→　「直原」
ループ３回目　→　「浅井」
ループ４回目　→　「弥中」

が表示されることになります。

しかし、現状のプログラムだと、

ループ１回目　→　「担当者」
ループ２回目　→　「山田」
ループ３回目　→　「直原」
ループ４回目　→　「浅井」
ループ５回目　→　「弥中」

と表示されてしまいます。

これを、１回目は「担当者」ではなく「山下」が表示されるようにしたいです。

該当のソースコード

Option Explicit

Private Sub cmd_start_Click()

Dim wbinput As Workbook                     'インプットファイル格納
Dim wbinput_Sheet As Worksheet              'インプットファイルのシート
Dim wboutput As Workbook                    'アウトプットファイル格納
Dim wboutput_Sheet As Worksheet             'アウトプットファイルのシート

Dim stroutput_FName As String
Dim strSheetName As String
Dim endcol As Long                          'エンド列名

Dim strcolor As String

Dim p As Long, n As Long                    'カウンタ変数
Dim r As Range, rr As Range, rs As Range    'Visibleセルを取得する変数


'+++++++++定義+++++++

p = 0
n = 2
strSheetName = "sheet1"

'+++++++++++++++++++
    
    'アウトプットファイルのファイル名取得
    stroutput_FName = ActiveWorkbook.Name
    
    'アウトプットファイルのファイルパスを取得
    Workbooks.Open ThisWorkbook.Path & "\" & stroutput_FName
    Set wboutput = ActiveWorkbook 'アクティブなワークブック


    'ほしいデータのあるシートをアクティブにする
    Set wboutput_Sheet = wboutput.Worksheets(strSheetName)
    wboutput_Sheet.Activate
            
            
    With wboutput
    
        'オートフィルタをセット
        Rows("1:1").Select
        Selection.AutoFilter
        ActiveSheet.Range("A1").AutoFilter Field:=1, Criteria1:=Array( _
        "パイナップル", "みかん", "リンゴ"), Operator:=xlFilterValues
        
        
        'オートフィルタの結果から担当者の名前をメッセージボックスで表示
        Set r = Range("C1", Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
        
        
        'r：A1～データの存在する最大行セルまでの範囲（表示されているセルのみ）
        'rr：A1～データの存在する最大行セルまで、A1から1つずつ格納される
        For Each rr In r
            
            'rsへ選択セルの値を格納
            For Each rs In rr.Areas
                
                '選択セルの行数を取得
                p = (rs.Row)
                
                'メッセージボックスに担当者名出力
                MsgBox (rr)
                              
                                
                 n = n + 1
            
            Next
        
        Next
        
        Application.DisplayAlerts = False
        
            .Close
            
        Application.DisplayAlerts = True
    
    End With
    
End Sub

試したこと

上記ソースが私が考えて書いたロジックです。
このままだと担当者名はちゃんとMsgboxで表示されるのですが、余計な「担当者」（C1セル）もメッセージされてしまっています。

そうではなくて、タイトル行を除いたデータだけを表示させるようにするには
どうしたらよいのでしょうか？

最初は、スタート時はタイトル行を除いてC2セルから固定でスタートさせようかと思ったのですが、オートフィルなので、もしかしたらオートフィル結果の最初の行はC4かもしれないしC5かもしれないこともあるので・・・
3日間色々と調べながら考えてやっと上記のソースまで来ましたが、タイトル行を除いてというところがどうしても分からず。

本来、
SpecialCells
があればオートフィルで可視化されたセルのみが表示されると思っていたのですが、どこが違うのでしょうか？

よろしくお願いいたします。

補足情報（FW/ツールのバージョンなど）

ここにより詳細な情報を記載してください。

Comments

[torisan]

参照先のソースでは動きませんでした。現在のソースとその結果を載せて下さい。

[退会済みユーザー]

こちらでは問題なく動いております。

念のためもう一度貼り付けておきますね。

Option Explicit

Private Sub cmd_start_Click()

Dim wbinput As Workbook 'インプットファイル格納
Dim wbinput_Sheet As Worksheet 'インプットファイルのシート
Dim wboutput As Workbook 'アウトプットファイル格納
Dim wboutput_Sheet As Worksheet 'アウトプットファイルのシート

Dim stroutput_FName As String
Dim strSheetName As String
Dim endcol As Long 'エンド列名

Dim strcolor As String

Dim p As Long, n As Long 'カウンタ変数
Dim r As Range, rr As Range, rs As Range 'Visibleセルを取得する変数

'+++++++++定義+++++++

p = 0
n = 2
strSheetName = "sheet1"

'+++++++++++++++++++

'アウトプットファイルのファイル名取得
stroutput_FName = ActiveWorkbook.Name

'アウトプットファイルのファイルパスを取得
Workbooks.Open ThisWorkbook.Path & "\" & stroutput_FName
Set wboutput = ActiveWorkbook 'アクティブなワークブック

'ほしいデータのあるシートをアクティブにする
Set wboutput_Sheet = wboutput.Worksheets(strSheetName)
wboutput_Sheet.Activate

With wboutput

'オートフィルタをセット
Rows("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("A1").AutoFilter Field:=1, Criteria1:=Array( _
"パイナップル", "みかん", "リンゴ"), Operator:=xlFilterValues

'オートフィルタの結果から担当者の名前をメッセージボックスで表示
Set r = Range("C1", Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)

'r：A1～データの存在する最大行セルまでの範囲（表示されているセルのみ）
'rr：A1～データの存在する最大行セルまで、A1から1つずつ格納される
For Each rr In r

'rsへ選択セルの値を格納
For Each rs In rr.Areas

'選択セルの行数を取得
p = (rs.Row)

'メッセージボックスに担当者名出力
MsgBox (rr)

'メッセージボックスにセル値出力
strcolor = Range("C" & p).Interior.Color

n = n + 1

Next

Next

Application.DisplayAlerts = False

.Close

Application.DisplayAlerts = True

End With

End Sub

あと、本文の方も貼り付けておきました。
また、今こちらで動かしているExcelデータもキャプチャして貼り付けておきました。
色々と申し訳ございませんが、よろしくお願いいたします。

Answer 1

質問者さんが最初に思っていた通り、C2からスタートする考え方でも問題ありません。
これで意図通りに動くはずです。

'RangeのC1をC2に変更。
Set r = Range("C2", Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)

試しにオートフィルの条件をパイナップルだけにしてみてください。
7行目の弥中だけが表示されるはずです。

あと、For Eachは全件処理しますのでカウンタは不要です。
n = n + 1
という1行は削除できますし、nの宣言も不要です。
ForとFor Eachの違いを確認されると良いでしょう。

ついでに、質問者さんのコードだと他の人は実行しても動きません。
念のために、誰でも動くコードを書いておきます。

Option Explicit

Private Sub cmd_start_Click()

    Dim r As Range, rr As Range, rs As Range    'Visibleセルを取得する変数

    'オートフィルタをセット
    Rows("1:1").Select
    Selection.AutoFilter
    ActiveSheet.Range("A1").AutoFilter Field:=1, Criteria1:=Array( _
    "パイナップル"), Operator:=xlFilterValues

    'オートフィルタの結果から担当者の名前をメッセージボックスで表示
    Set r = Range("C2", Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)

    'r：A1～データの存在する最大行セルまでの範囲（表示されているセルのみ）
    'rr：A1～データの存在する最大行セルまで、A1から1つずつ格納される
    For Each rr In r
        'rsへ選択セルの値を格納
        For Each rs In rr.Areas
            MsgBox (rr)
        Next
    Next

End Sub

Comments

[退会済みユーザー]

お返事が遅くなってしまい申し訳ございませんでした。

＞あと、For Eachは全件処理しますのでカウンタは不要です。
n = n + 1
という1行は削除できますし、nの宣言も不要です。
ForとFor Eachの違いを確認されると良いでしょう。

余計なコードのご指摘をありがとうございました。
そうですね、For　と　For Eachの違いをよく分かっていなかったことにも気づかされました。
ご丁寧にありがとうございました。

Answer 2

タイトル行を除いたデータだけを表示させるようにするには

そういう場合は、いろいろやり方がありますが、
Intersect関数を使うのが便利です。

Option Explicit

Private Sub cmd_start_Click()
    Const stroutput_FName As String = "てすと"
    Const strSheetName As String = "Sheet1"
    Dim wbkData As Workbook                     'アウトプットファイル格納
    Dim rngTarget As Range                      '抽出された担当者のセル範囲
    Dim c As Range                              '各セル

    'ほしいデータのあるブックを開く
    Set wbkData = Workbooks.Open(ThisWorkbook.Path & "\" & stroutput_FName)

    'シート名「Sheet1」に対しての操作
    With wbkData.Worksheets(strSheetName)
        '既にオートフィルターが掛かっているかチェックして
        '掛かっていたらいったん解除
        If .AutoFilterMode Then .AutoFilterMode = False

        '指定の値でオートフィルタをセット
        .Range("A1").AutoFilter _
                Field:=1, _
                Criteria1:=Array("パイナップル", "みかん", "リンゴ"), _
                Operator:=xlFilterValues

        'オートフィルターが掛かっているセル範囲に対する操作
        With .AutoFilter.Range
            '抽出が0件なら、終了処理へ
            If .Columns("A").SpecialCells(xlCellTypeVisible).Count = 1 Then GoTo WayOut
            '表示されている担当者のセルを取得
            Set rngTarget = Intersect(.Cells, .Offset(1), .Columns("C")) _
                            .SpecialCells(xlCellTypeVisible)
        End With
    End With


    'セルの値を順に表示
    For Each c In rngTarget.Cells
        MsgBox c.Value
    Next

WayOut:
    wbkData.Close False
End Sub

まだ、開発途中だとは思いますが、
無駄な変数、
無駄な空白行、
無駄なセルの選択、
文章の途中での改行、
等々非常に読みにくくないですか？

読んでみて
要点が分かり難い文章（=コード）だなぁという印象です。

Comments

[退会済みユーザー]

お返事が遅くなってしまい申し訳ございませんでした。
そして色々とご指摘ありがとうございました。

そうですね。私ももっと他の方々のコードなどを見て勉強していきたいと思います。