tagCANDY CGI VBレスキュー(花ちゃん)の Visual Basic 6.0用 掲示板
VBレスキュー(花ちゃん)の Visual Basic 6.0用 掲示板
[ツリー表示へ]  [ワード検索]  [Home]

タイトル 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
あいうえ

- 関連一覧ツリー をクリックするとツリー全体を一括表示します)

古いスレッドにレスはつけられません。