VBA：Excel VBA ：Tips：検索

指定文字列のアドレス検索

yukibe33.hatenablog.jp

指定文字のアドレス

指定文字列を検索して、アドレスを調べる。
「シート全体検索」「行検索」
表などの列の場所を調べるのに役立つかも．．．

シート

'https://www.sejuku.net/blog/31055
Private Sub btn_指定文字のアドレス_Click()

    '//############################################
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("TEST")
    '//############################################
    
    Dim Rng As Range
    Set Rng = ws.Cells.Find(What:="TEST", LookIn:=xlValues, LookAt:=xlWhole)
    If Not Rng Is Nothing Then
        
        Debug.Print Rng.Column
        Debug.Print Rng.Row
        Debug.Print mth_列アドレス_数値文字変換(Rng.Column)

    End If
    
    '//############################################
    Set Rng = Nothing
    Set ws = Nothing
    '//############################################

End Sub


Function mth_列アドレス_数値文字変換(lCol As Long) As String

    Dim sBuf As String
    
    sBuf = Cells(1, lCol).Address(True, False) '列のみ相対参照 (ex)A$1
    sBuf = Left(sBuf, InStr(sBuf, "$") - 1)

    
    mth_列アドレス_数値文字変換 = sBuf
    
End Function

行検索（該当文字列の列アドレスを取得）

Private Sub btn_指定文字のアドレス_行_Click()

    '//############################################
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("TEST")
    '//############################################
    
    Dim searchRng As Range
    Set searchRng = ws.Rows(11)
    
    Dim resRng As Range
    Set resRng = searchRng.Cells.Find( _
                                    What:="TEST", _
                                    LookIn:=xlValues, _
                                    LookAt:=xlWhole, _
                                    SearchOrder:=xlByColumns _
                                    )
    If Not resRng Is Nothing Then
        
        Debug.Print resRng.Column
        Debug.Print resRng.Row
        Debug.Print mth_列アドレス_数値文字変換(resRng.Column)

    End If
    
    '//############################################
    Set searchRng = Nothing
    Set resRng = Nothing
    Set ws = Nothing
    '//############################################

End Sub

複数存在するセルを検索

シート／行

Private Sub btn_指定文字のアドレス_複数_Click()

    '//############################################
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("TEST")
    '//############################################
    Dim v As Variant
    
    
    Dim rngFindCell As Range
    Dim rngFind_1st As Range
    Dim rngFind_List As Range
    
    
    '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
    '$ シート検索
    '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
    Set rngFindCell = ws.Cells.Find( _
                                What:="TEST", _
                                LookIn:=xlValues, _
                                LookAt:=xlWhole _
                                )
                                
    
    If rngFindCell Is Nothing Then
        MsgBox "見つかりません"
        Exit Sub
    Else
        Set rngFind_1st = rngFindCell
        Set rngFind_List = rngFindCell
    End If
    
    '-----------------------------------------------------
    ' シート全体検索(FindNext) → Rangeリスト追加
    '-----------------------------------------------------
    Do
        Set rngFindCell = ws.Cells.FindNext(rngFindCell)
        
        If rngFindCell.Address = rngFind_1st.Address Then
            Exit Do
        Else
            Set rngFind_List = Union(rngFind_List, rngFindCell)
        End If
    Loop
    
    '-----------
    ' Result
    '-----------
    ' セル
    For Each v In rngFind_List
        Debug.Print v.Address
    Next
    
    ' 表(かたまり)リスト LOOP
    For Each v In rngFind_List.Areas
        Debug.Print v.Address
    Next
    'Debug.Print rngFind_List.Areas(1).Address
    
    rngFind_List.Select
    MsgBox rngFind_List.Count & "件見つかりました"
    
    
    '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
    '$ 行検索
    '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
    '-----------------------------------------------------
    ' 行検索
    '-----------------------------------------------------
    Dim srhRng_Row As Range
    Set srhRng_Row = ws.Rows(12)
    Set rngFindCell = srhRng_Row.Find( _
                                What:="TEST", _
                                LookIn:=xlValues, _
                                LookAt:=xlWhole, _
                                    SearchOrder:=xlByColumns _
                                )
                                
    If rngFindCell Is Nothing Then
        MsgBox "見つかりません"
        Exit Sub
    Else
        Set rngFind_1st = rngFindCell
        Set rngFind_List = rngFindCell
    End If
    
    '-----------------------------------------------------
    ' 行検索(FindNext) → Rangeリスト追加
    '-----------------------------------------------------
    Do
'        Set rngFindCell = srhRng_Row.Cells.FindNext(rngFindCell)
        Set rngFindCell = srhRng_Row.FindNext(rngFindCell)
        If rngFindCell.Address = rngFind_1st.Address Then
            Exit Do
        Else
            Set rngFind_List = Union(rngFind_List, rngFindCell)
        End If
    Loop
    
    '-----------
    ' Result
    '-----------
    ' セル
    For Each v In rngFind_List
        Debug.Print v.Address
    Next
    
    ' 表(かたまり)リスト LOOP
    For Each v In rngFind_List.Areas
        Debug.Print v.Address
    Next
    
    rngFind_List.Select
    MsgBox rngFind_List.Count & "件見つかりました"
    
End Sub