タイトル : Re^6: エラー処理追加(修正) 投稿日 : 2009/11/13(Fri) 15:20 投稿者 : 花ちゃん
> 私もサンプルで 下記ならどのようになりますか? Debug.Print Extex3("ABSCD1234EFG", "ABCD", "EFG") Debug.Print Extex3("ABSCD1234EFGABCD123EFG", "ABCD", "EFG") 一応、見つかった分だけ取得できるように作って見ました。 Private Sub Command1_Click() Dim S() As String Dim i As Long S = Extex2("ABCD1234EFGABCD1ABCD234EFGACCD123EFGKHABCDあいうえEFG", "ABCD", "EFG") If UBound(S) = -1 Then Debug.Print "見つかりませんでした。" Else For i = LBound(S) To UBound(S) Debug.Print S(i) Next i End If End Sub Private Function Extex2(ByVal Origin As String, _ ByVal LSideword As String, ByVal RSideword As String) As String() Dim Dt1 As Long, Dt2 As Long '検索結果の見つかった位置 Dim LenOr As Long, LenLS As Long, LenRS As Long '夫々の文字列長 Dim Pos As Long '検索開始位置 Dim N As Long '見つかった件数 Dim ss() As String '見つかった文字列 Extex2 = Split("") '見つからなかった場合エラーを返さないように LenOr = Len(Origin) LenLS = Len(LSideword) LenRS = Len(RSideword) Dt1 = InStr(1, Origin, LSideword) Dt2 = InStr(1, Origin, RSideword) Pos = 0: N = -1 If LenOr = 0 Or LenLS = 0 Or LenRS = 0 Or Dt1 = 0 Or Dt2 = 0 Then Exit Function End If '前方の検索文字が存在する場合処理を続ける Do While Dt1 > 0 '前方の検索文字が見つかった次の位置から後方の検索文字を検索 Dt2 = InStr(Dt1 + LenLS, Origin, RSideword) '後方の検索文字が見つからなかったら処理を抜ける If Dt2 = 0 Then Exit Do End If N = N + 1 ReDim Preserve ss(N) '見つかった文字を配列に保存 ss(N) = Mid$(Origin, LenLS + Dt1, Dt2 - (Dt1 + LenLS)) Pos = Dt2 + LenRS '次の検索開始位置 '最後まで検索したら処理を抜ける If Pos >= LenOr Then Exit Do End If '次の前方の検索文字の有無を調べる Dt1 = InStr(Pos, Origin, LSideword) Loop Extex2 = ss End Function 結果 1234 1ABCD234 あいうえ |