VBA：Excel ：検索（行番号）

指定文字列の行番号取得

『シート全体』指定文字列の行番号取得

'■■■■■■■■■■■■■■■■■■■■■■■■■
'// 『シート全体』指定文字列の行番号取得
'//
'■■■■■■■■■■■■■■■■■■■■■■■■■
Private Sub psub_シート全体_指定文字列の行番号アドレス検索()

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(1)
    
    Dim sShrStr As String
    sShrStr = "検索"
    
    Dim lRes() As Long
    lRes = mth_GetCellRowNo_Sheet( _
                                    ws, _
                                    sShrStr _
                                    )
    
    Set ws = Nothing

End Sub

'*************************************************************************
'機能   : シート全体、指定文字列のアドレス検索
'戻り値 : アドレス配列
'ARG1   : WorkSheet
'ARG2   : 検索文字列
'説明   :
'*************************************************************************
Public Function mth_GetCellRowNo_Sheet( _
                                        ws As Worksheet, _
                                        sSrhString _
                                        ) As Long()

    Dim lRes_RowNo() As Long
    Dim vRes_RowNoBuf()
    
    Dim v As Variant
    
    Dim rngFindCell As Range
    Dim rngFind_1st As Range
    Dim rngFind_List As Range
    
    '===========================
    '// シート全体検索
    '===========================
    'LookIn:=xlValues 値検索
    'LookAt:=xlWhole 完全一致
    'MatchCase:=true 大文字と小文字を区別する(True)
    'MatchByte:=True 半角と全角を区別する(True)
    'SearchFormat 書式を検索しない(False)
    Set rngFindCell = ws.Cells.Find( _
                                    what:=sSrhString, _
                                    LookIn:=xlValues, _
                                    LookAt:=xlWhole, _
                                    MatchCase:=True, _
                                    MatchByte:=True, _
                                    SearchFormat:=False _
                                    )
    
    If rngFindCell Is Nothing Then
        Exit Function
    Else
        Set rngFind_1st = rngFindCell
        Set rngFind_List = rngFindCell
    End If
    
    '--------------------------------------------
    '// 検索 → Rangeリスト追加
    '--------------------------------------------
    Do
        '// 以降の検索条件も同一で検索
        Set rngFindCell = ws.Cells.FindNext(rngFindCell)
        
        '// 処理
        If rngFindCell.Address = rngFind_1st.Address Then
            Exit Do '// 最初に見つかったものと同じなら終了
        Else
            'Find_Listに追加していく
            Set rngFind_List = Union(rngFind_List, rngFindCell)
        End If
    Loop
    
    '---------------
    '// Result
    '---------------
    Dim i As Long: i = 0
    For Each v In rngFind_List
        ReDim Preserve vRes_RowNoBuf(i)
        vRes_RowNoBuf(i) = v.Row
        i = i + 1
    Next
    
    '// 重複削除
    vRes_RowNoBuf = m_配列.mth_DelSameVal(vRes_RowNoBuf)
    
    '// Variant -> Long
    For i = LBound(vRes_RowNoBuf) To UBound(vRes_RowNoBuf)
        ReDim Preserve lRes_RowNo(i)
        lRes_RowNo(i) = vRes_RowNoBuf(i)
    Next
    
    mth_GetCellRowNo_Sheet = lRes_RowNo
    
    '---------------
    '// 後処理
    '---------------
    Set rngFindCell = Nothing
    Set rngFind_1st = Nothing
    Set rngFind_List = Nothing
    
End Function

『範囲指定(Range)』指定文字列の行番号取得

'■■■■■■■■■■■■■■■■■■■■■■■■■
'// 『範囲指定(Range)』指定文字列の行番号取得
'//
'■■■■■■■■■■■■■■■■■■■■■■■■■
Private Sub psub_範囲_指定文字列の行番号アドレス検索()

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(1)
    
    Dim rng As Range
    Set rng = ws.Range("B2:E23")
    
    Dim sShrStr As String
    sShrStr = "検索"
    
    Dim lRes() As Long
    lRes = mth_GetCellRowNo_Range( _
                                    rng, _
                                    sShrStr _
                                    )
    
    Set ws = Nothing

End Sub

'*************************************************************************
'機能   : 『範囲指定(Range)』指定文字列の行番号取得
'戻り値 : アドレス配列
'ARG1   : Range
'ARG2   : 検索文字列
'説明   :
'*************************************************************************
Public Function mth_GetCellRowNo_Range( _
                                        rng As Range, _
                                        sSrhString _
                                        ) As Long()

    Dim lRes_RowNo() As Long
    Dim vRes_RowNoBuf()
    
    Dim v As Variant
    
    Dim rngFindCell As Range
    Dim rngFind_1st As Range
    Dim rngFind_List As Range
    
    '===========================
    '// シート全体検索
    '===========================
    'LookIn:=xlValues 値検索
    'LookAt:=xlWhole 完全一致
    'MatchCase:=true 大文字と小文字を区別する(True)
    'MatchByte:=True 半角と全角を区別する(True)
    'SearchFormat 書式を検索しない(False)
    Set rngFindCell = rng.Find( _
                                    what:=sSrhString, _
                                    LookIn:=xlValues, _
                                    LookAt:=xlWhole, _
                                    MatchCase:=True, _
                                    MatchByte:=True, _
                                    SearchFormat:=False _
                                    )
    
    If rngFindCell Is Nothing Then
        Exit Function
    Else
        Set rngFind_1st = rngFindCell
        Set rngFind_List = rngFindCell
    End If
    
    '--------------------------------------------
    '// 検索 → Rangeリスト追加
    '--------------------------------------------
    Do
        '// 以降の検索条件も同一で検索
        Set rngFindCell = rng.FindNext(rngFindCell)
        
        '// 処理
        If rngFindCell.Address = rngFind_1st.Address Then
            Exit Do '// 最初に見つかったものと同じなら終了
        Else
            'Find_Listに追加していく
            Set rngFind_List = Union(rngFind_List, rngFindCell)
        End If
    Loop
    
    '---------------
    '// Result
    '---------------
    Dim i As Long: i = 0
    For Each v In rngFind_List
        ReDim Preserve vRes_RowNoBuf(i)
        vRes_RowNoBuf(i) = v.Row
        i = i + 1
    Next
    
    '// 重複削除
    vRes_RowNoBuf = m_配列.mth_DelSameVal(vRes_RowNoBuf)
    
    '// Variant -> Long
    For i = LBound(vRes_RowNoBuf) To UBound(vRes_RowNoBuf)
        ReDim Preserve lRes_RowNo(i)
        lRes_RowNo(i) = vRes_RowNoBuf(i)
    Next
    
    mth_GetCellRowNo_Range = lRes_RowNo
    
    '---------------
    '// 後処理
    '---------------
    Set rngFindCell = Nothing
    Set rngFind_1st = Nothing
    Set rngFind_List = Nothing
    
End Function

『指定行範囲』指定文字列の行番号取得

'■■■■■■■■■■■■■■■■■■■■■■■■■
'// 『指定行範囲』指定文字列の行番号取得
'//
'■■■■■■■■■■■■■■■■■■■■■■■■■
Private Sub psub_指定行範囲_指定文字列の行番号アドレス検索()

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(1)
    
    Dim rng As Range
    Set rng = ws.Rows("2:12")
    
    Dim sShrStr As String
    sShrStr = "検索"
    
    Dim lRes() As Long
    lRes = mth_GetCellRowNo_Range( _
                                    rng, _
                                    sShrStr _
                                    )
    
    Set ws = Nothing

End Sub

重複削除

'*************************************************************************
'機能   : 重複削除
'戻り値 : 配列
'ARG1   : 配列
'説明   : Dictionaryで配列要素をKey､Valを追加
'           Key重複できないのでErrで追加不可
'           Key(Val)値は、重複削除の値となる
'*************************************************************************
Public Function mth_DelSameVal(vArrSrc() As Variant) As Variant()
    
    Dim dic
    Dim i As Long
    
    Set dic = CreateObject("Scripting.Dictionary")

On Error Resume Next
    For i = 0 To UBound(vArrSrc)
        dic.Add vArrSrc(i), vArrSrc(i)
    Next
    
    mth_DelSameVal = dic.keys
    
    Set dic = Nothing

End Function