指定した内容で文字列を検索し、見つかった位置と文字列長を配列で返却する
引数情報指定
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' 検索情報配列取得
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' 引数情報初期化
'------------------------------------------------------------------------------
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