0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

検索情報配列取得

Last updated at Posted at 2025-04-26

指定した内容で文字列を検索し、見つかった位置と文字列長を配列で返却する

引数情報指定

'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' 検索情報配列取得
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' 引数情報初期化
'------------------------------------------------------------------------------
Public Property Get G_String_InitArgSrchInf() As T_STRING_ARG_SEARCH_INF
    Dim wkInf As T_STRING_ARG_SEARCH_INF
    
    With wkInf
        .Target = ""
        
        .Search = ""
        .SrchSpec = E_STRING_SPEC_MATCH_MID
        .SrchPtn = ""
        
        .ChkPtn = ""
        .ChkSpec = E_STRING_SPEC_MATCH_ALL
        .ChkPtnOfs = 1
        
        .SttPos = D_POS_START
        .EndPos = D_POS_END
        .Length = D_POS_END
        
        .GetIdx = D_IDX_ALL
    End With
    
    G_String_InitArgSrchInf = wkInf
End Property

'------------------------------------------------------------------------------
' 検索情報配列取得(引数情報指定)
'------------------------------------------------------------------------------
Public Function F_String_GetSearchInfArray_Inf( _
        ByRef aRtnAryAry As Variant, _
        ByRef aArgInf As T_STRING_ARG_SEARCH_INF) As Boolean
    Dim wkRtnAryAry As Variant
    Dim wkRtnAry(D_IDX_START To E_STRING_IDX_SRCH_INF_EEND) As Variant
    Dim wkAddFlg As Boolean
    
    Dim wkArgInf As T_STRING_ARG_SEARCH_INF: wkArgInf = aArgInf
    Dim wkSttPos As Long, wkEndPos As Long
    Dim wkTgtLen As Long
    
    Dim wkSrchPtn As String
    Dim wkSrchRegExp As RegExp
    Dim wkMatch As Variant
    Dim wkMatchCnt As Long
    
    Dim wkChkPtn As String
    Dim wkChkRegExp As RegExp
    Dim wkChkStt As Long, wkChkEnd As Long
    
    Dim wkGetIdx As Long
    Dim wkRtnIdx As Long
    
    On Error GoTo PROC_ERROR
    With aArgInf
        '引数チェック
        If .Target = "" Or (.Search = "" And .SrchPtn = "") Or .SttPos < D_POS_START Then
            Exit Function
        End If
        
        '終端位置調整
        wkSttPos = .SttPos
        wkEndPos = .EndPos
        wkTgtLen = Len(.Target)
        If PF_String_GetPosEndAdjust(wkEndPos, Len(.Target), wkSttPos, .Length) <> True Then
            Exit Function
        End If
        
        '検索パターン保持
        wkSrchPtn = .SrchPtn
        If wkSrchPtn = "" Then
            '検索パターンを作成
            wkSrchPtn = PF_String_ReturnSearchPattern(.Search, .SrchSpec)
        End If
        
        '検索パターン設定、検索実施
        Set wkSrchRegExp = New RegExp
        With wkSrchRegExp
            .IgnoreCase = False
            .Global = True
            .Pattern = wkSrchPtn
        End With
        Set wkMatch = wkSrchRegExp.Execute(Mid(.Target, wkSttPos, (wkEndPos - wkSttPos + 1)))
        '検索結果が無ければ終了
        If wkMatch.Count <= 0 Then
            Exit Function
        End If
        
        '一致パターンがある場合
        If .ChkPtn <> "" And .ChkPtnOfs > 0 Then
            'チェック指定がある場合
            If M_Common.F_CheckBitOn(.ChkSpec, E_STRING_SPEC_MATCH_MASK) = True Then
                '一致パターン作成
                If M_Common.F_CheckBitOn(.ChkSpec, E_STRING_SPEC_MATCH_WORD) = True Then
                    wkChkPtn = PF_String_ReturnCheckPatternWord(wkSrchPtn, .SrchSpec, .ChkPtn, .ChkSpec)
                Else
                    wkChkPtn = PF_String_ReturnCheckPattern(wkSrchPtn, .SrchSpec, .ChkPtn, .ChkSpec)
                End If
            End If
            
            'チェックパターンがある場合、チェックパターン設定
            If wkChkPtn <> "" Then
                'チェック検索設定
                Set wkChkRegExp = New RegExp
                With wkChkRegExp
                    .IgnoreCase = False
                    .Global = False
                    .Pattern = wkChkPtn
                End With
            End If
        End If
        
        '検索ヒット数分、位置情報を抽出
        wkGetIdx = D_IDX_START
        wkRtnIdx = D_IDX_START
        For wkMatchCnt = 0 To wkMatch.Count - 1
            '初期化
            wkAddFlg = True
            wkRtnAry(E_STRING_IDX_SRCH_INF_POS_START) = wkSttPos + wkMatch.Item(wkMatchCnt).FirstIndex
            wkRtnAry(E_STRING_IDX_SRCH_INF_LENGTH) = wkMatch.Item(wkMatchCnt).Length
                
            If Not wkChkRegExp Is Nothing Then
                'チェック位置調整
                wkChkStt = wkRtnAry(E_STRING_IDX_SRCH_INF_POS_START)
                wkChkEnd = wkChkStt + wkRtnAry(E_STRING_IDX_SRCH_INF_LENGTH) - 1
    
                '開始位置調整
                wkChkStt = wkChkStt - .ChkPtnOfs
                If wkChkStt < D_POS_START Then
                    wkChkStt = D_POS_START
                End If
                '終了位置調整
                wkChkEnd = wkChkEnd + .ChkPtnOfs
                If wkChkEnd > wkTgtLen Then
                    wkChkEnd = wkTgtLen
                End If
                    
                wkAddFlg = wkChkRegExp.Test(Mid(.Target, wkChkStt, (wkChkEnd - wkChkStt + 1)))
            End If
                
            If wkAddFlg = True Then
                '取得インデックスが設定なしまたは取得インデックスが一致の場合、戻り引数に設定
                If .GetIdx < D_IDX_START Or wkGetIdx = .GetIdx Then
                    '取得カウンタが全取得の場合は設定位置を調整
                    If .GetIdx = D_IDX_ALL Then
                        wkRtnIdx = wkGetIdx
                    End If
                    '取得結果を配列に登録
                    wkRtnAryAry = M_Common.F_ReturnArrayAdd(wkRtnAryAry, wkRtnAry, aIdx:=wkRtnIdx)
                    
                    'インデックスが一致の場合は取得完了のためループ終了
                    If wkGetIdx = .GetIdx Then
                        Exit For
                    End If
                End If
                
                '取得カウンタ更新
                wkGetIdx = wkGetIdx + 1
            End If
        Next wkMatchCnt
    End With
    On Error GoTo 0
    
    '指定パターンが見つかった場合
    If IsArray(wkRtnAryAry) = True Then
        aRtnAryAry = wkRtnAryAry
        F_String_GetSearchInfArray_Inf = True
    End If
    
PROC_ERROR:
    '何もしない
End Function

引数指定

'------------------------------------------------------------------------------
' 検索情報配列取得(引数指定)
'------------------------------------------------------------------------------
Public Function F_String_GetSearchInfArray( _
        ByRef aRtnAryAry As Variant, _
        ByVal aTarget As String, _
        Optional ByVal aSearch As String = "", Optional ByVal aSrchSpec As E_STRING_SPEC = E_STRING_SPEC_MATCH_MID, Optional ByVal aSrchPtn As String = "") As Boolean
    Dim wkArgInf As T_STRING_ARG_SEARCH_INF: wkArgInf = G_String_InitArgSrchInf()
    
    With wkArgInf
        .Target = aTarget
        .Search = aSearch
        .SrchSpec = aSrchSpec
        .SrchPtn = aSrchPtn
    End With
    
    F_String_GetSearchInfArray = F_String_GetSearchInfArray_Inf(aRtnAryAry, wkArgInf)
End Function

単語検索(引数指定)

'------------------------------------------------------------------------------
' 単語検索情報配列取得(引数指定)
'------------------------------------------------------------------------------
Public Function F_String_GetSearchInfArrayWord( _
        ByRef aRtnAryAry As Variant, _
        ByVal aTarget As String, _
        Optional ByVal aSearch As String = "", Optional ByVal aSrchSpec As E_STRING_SPEC = E_STRING_SPEC_MATCH_MID, Optional ByVal aSrchPtn As String = "", _
        Optional ByVal aChkPtn As String = D_STRING_MATCH_CHECKWORD, Optional ByVal aChkSpec As E_STRING_SPEC = E_STRING_SPEC_MATCH_ALL) As Boolean
    Dim wkArgInf As T_STRING_ARG_SEARCH_INF: wkArgInf = G_String_InitArgSrchInf()
    
    '引数情報に設定
    With wkArgInf
        .Target = aTarget
        .Search = aSearch
        .SrchSpec = aSrchSpec
        
        .ChkPtn = aChkPtn
        .ChkSpec = aChkSpec Or E_STRING_SPEC_MATCH_WORD
    End With
    
    F_String_GetSearchInfArrayWord = F_String_GetSearchInfArray_Inf(aRtnAryAry, wkArgInf)
End Function
0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?