tagCANDY CGI VBレスキュー(花ちゃん) - VBレスキュー(花ちゃん)の投稿サンプル用掲示板 - Visual Basic 6.0 VB2005 VB2010
VB2005用トップページへVBレスキュー(花ちゃん)のトップページVB6.0用のトップページ
VBレスキュー(花ちゃん)の投稿サンプル用掲示板
     サンプル投稿用掲示板  VB2005 〜 用トップページ  VB6.0 用 トップページ
指定した文字列と文字列の間の文字列を取得する関数(VB6.0) ( No.0 )  [親スレッドへ]
日時: 2009/11/14 10:58
名前: 花ちゃん

***********************************************************************************
* カテゴリー:[文字列処理][][]                                                    *
* キーワード:文字列関数,指定文字列の抜き取り,タグ内文字列,検索,                  *
***********************************************************************************
タイトル : 指定した文字列と文字列の間の文字列を取得する関数(VB6.0)
記 事 No : 14241
投 稿 日 : 2009/11/10(Tue) 18:18
投 稿 者 : S.eleven  

タイトル通りの関数が無いかとここで質問しようと考えネットで調べたのですが
それらしきサンプルは見つからず結果的に頑張って自作できたのでここに載せておきます。
---------------------------------------------------------------------------------
と言って投稿して頂いたのですが、バグがあったりとか初心者の方に真似してほしくない
作法の部分があったので、代わりに、私なりに作成したものを投稿しておきます。
--------------------------------------------------------------------------------
回 答 者 : 花ちゃん
 記事No : 14242    記事No : 14265  も参照願います。
 他にも色々投稿がありますが、全てが完成品ではありませんので、一連のスレッドの
 内容をよく読んでからご利用されるようにして下さい。

最初に見つかった分だけを返す関数と存在する分だけ取得する関数の2個を投稿しておきます
--------------------------------------------------------------------------------

Option Explicit

Private Function Extex1(ByVal Origin As String, _
         ByVal LSideword As String, ByVal RSideword As String) As String
'********1*********2*********3*********4*********5*********6*********7*********8
'*: Name        : Extex1 (指定した文字列と文字列の間の文字列を取得する関数)
'*:
'*: 使用例      : Extex1("ABCD123EFG", "ABCD", "EFG")
'*:
'*: Origin      : 調査対象の文字列 (String)              'ABCD123EFG
'*:
'*: LSideword   : 指定する前方文字列 (String)            'ABCD
'*:
'*: RSideword   : 指定する前方文字列 (String)            'EFG
'*:
'*: 戻り値   : 最初に見つかった文字列 (String)        '123
'*:
'*: 備 考      : 複数存在していても最初に見つかった分だけしか返しません。
'*:        見つからなかった場合は、"" を返します。
'********1*********2*********3*********4*********5*********6*********7*********8
  
   Dim Dt1  As Long, Dt2  As Long, LenN As Long
   LenN = Len(LSideword)               '前方文字列長を取得
   Dt1 = InStr(Origin, LSideword)      '前方文字列の見つかった位置
   If Dt1 = 0 Or Len(Origin) = 0 Or Len(RSideword) = 0 Then
      '前方文字列が見るからない場合及び各文字列が "" の場合処理を抜ける。
      Exit Function
   End If
   '後方文字列の見つかった位置
   Dt2 = InStr(Dt1 + LenN, Origin, RSideword)
   If Dt2 > 0 Then
      '見つかった文字列だけを抜き取り
      Extex1 = Mid$(Origin, Dt1 + LenN, Dt2 - (Dt1 + LenN))
   End If
End Function

Private Sub Command1_Click()
   Debug.Print Extex1("ABCD123EFG", "ABCD", "EFG")       '結果 123
   Debug.Print Extex1("ABCD1ABCD234EFG", "ABCD", "EFG")  '結果 1ABCD234
   Debug.Print Extex1("ACCD123GKH", "ABCD", "EFG")       '結果 ""
   Debug.Print Extex1("ABCD123EFGABCD1ABCD234EFG123EFGK", "ABCD", "EFG") ' 123
End Sub


Private Function Extexs(ByVal Origin As String, _
      ByVal LSideword As String, ByVal RSideword As String) As String()
'********1*********2*********3*********4*********5*********6*********7*********8
'*: Name        : Extexs (指定した文字列と文字列の間の文字列を取得する関数)
'*:
'*: 使用例      : S = Extexs("ABCD1234EFGABCD1ABCD234EFGAC", "ABCD", "EFG")
'*:
'*: Origin      : 調査対象の文字列 (String)              '上記参照
'*:
'*: LSideword   : 指定する前方文字列 (String)            'ABCD
'*:
'*: RSideword   : 指定する前方文字列 (String)            'EFG
'*:
'*: 戻り値   : 見つかった文字列の配列 (String)        '1234 ,1ABCD234
'*:
'*: 備 考      : 複数存在する場合は、見つかった分だけ配列で返します。
'*:        見つからなかった場合は、UBound(S) = -1 を返します。
'*:               ( S(0) を参照するとエラーが発生します。)
'********1*********2*********3*********4*********5*********6*********7*********8
  
   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                              '見つかった文字列
   Extexs = 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
   Extexs = ss
End Function

Private Sub Command2_Click()
   Dim S() As String
   Dim i As Long
   S = Extexs("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

'  結果
'  1234
'  1ABCD234
'  あいうえ
End Sub



 [スレッド一覧へ] [親スレッドへ]