tagCANDY CGI VBレスキュー(花ちゃん)の Visual Basic 6.0用 掲示板 [ツリー表示へ]   [Home]
一括表示(VB6.0)
タイトル指定した文字列と文字列の間の文字列を取得する関数(VB6.0)
記事No14241
投稿日: 2009/11/10(Tue) 18:18
投稿者S.eleven
タイトル通りの関数が無いかとここで質問しようと考え
ネットで調べたのですがそれらしきサンプルは見つからず
結果的に頑張って自作できたのでここに載せておきます。




'==========================================================
'文字列と文字列の間の文字列を取得(トリミング)する
'==========================================================
' result = Extex("ABCD123EFG","ABCD","EFG")
'
' 引数  Origin     :対象文字列 (ABCD123EFG)
'       Lsideword  :前方文字列 (ABCD)
'       Rsideword  :後方文字列 (EFG)
'
' 戻値 result   :結果 (123)
'----------------------------------------------------------

Public Function Extex(Origin As Variant, LSideword As String, RSideword As String) As Variant

Dim Dt As Variant

  Dt = InStr(Origin, LSideword)
   Dt = Mid(Origin, Dt + Len(LSideword), Len(Origin))
    Extex = Dt
     Dt = InStr(Extex, RSideword)
Extex = Mid(Extex, 1, Dt - 1)

End Function

[ツリー表示へ]
タイトルRe: 指定した文字列と文字列の間の文字列を取得する関数(VB6.0)
記事No14242
投稿日: 2009/11/10(Tue) 19:29
投稿者花ちゃん
> 結果的に頑張って自作できたのでここに載せておきます。
見つからなかった場合等問題ありませんか?
チョット試して見ました。

Option Explicit

Public Function Extex(Origin As Variant, LSideword As String, _
                                    RSideword As String) As Variant
   Dim Dt As Variant
   Dt = InStr(Origin, LSideword)
   Dt = Mid(Origin, Dt + Len(LSideword), Len(Origin))
   Extex = Dt
   Dt = InStr(Extex, RSideword)
   Extex = Mid(Extex, 1, Dt - 1)

End Function

Public Function Extex2(ByVal Origin As String, _
      ByVal LSideword As String, ByVal RSideword As String) As String
   Dim Dt1  As Long
   Dim Dt2  As Long
   Dim LenN As Long
   Extex2 = ""
   LenN = Len(LSideword)
   Dt1 = InStr(Origin, LSideword)
   If Dt1 = 0 Then
      Exit Function
   End If
   Dt2 = InStr(Dt1 + LenN, Origin, RSideword)
   If Dt2 > 0 Then
      Extex2 = Mid$(Origin, Dt1 + LenN, Dt2 - (Dt1 + LenN))
   End If
   '本来は、複数個見つかる場合も想定し最後まで検索する必要もあるかと。
   '又、() 内の文字を取得したい場合等は、処理がもう少し複雑になります。
End Function

Private Sub Command1_Click()
   Debug.Print "Extex2 : " & Extex2("ACCD123EFGKH", "ABCD", "EFG")
    Debug.Print "Extex  : " & Extex("ACCD123EFGKH", "ABCD", "EFG")
    Debug.Print "Extex  : " & Extex("ACCD123GKH", "ABCD", "EFG")
End Sub

結果
Extex2 :
Extex  : D123
エラー

[ツリー表示へ]
タイトルエラー処理追加(修正)
記事No14245
投稿日: 2009/11/11(Wed) 13:10
投稿者S.Eleven
エラーが起きない前提で作っていました申し訳ありません
エラー処理を追加しましたので載せます。


'==========================================================
'文字列と文字列の間の文字列を取得(トリミング)する
'==========================================================
' result = Extex("ABCD123EFG","ABCD","EFG")
'
' 引数  Origin     :対象文字列 (ABCD123EFG)
'       LSideword   :前方文字列 (ABCD)
'       RSideword   :後方文字列 (EFG)
'
' 戻値 result   :結果 (123)
'       エラー    : err.0(前方文字列が見つかりません),
'                 : err.1(後方文字列が見つかりません),
'                 : err.2(不明のエラー),
'                 : err.3(第一引数(Origin)が空です),
'                 : err.4(第二引数(LSideword)が空です),
'                 : err.5(第三引数(RSideword)が空です)
'----------------------------------------------------------

Public Function Extex(Origin As Variant, LSideword As String, RSideword As String) As Variant
On Error GoTo ferr

Dim Dt As Variant

If Origin = "" Then
Extex = "err.3"
GoTo fend
Else
If LSideword = "" Then
Extex = "err.4"
GoTo fend
Else
If RSideword = "" Then
Extex = "err.5"
GoTo fend
End If
End If
End If


  Dt = InStr(Origin, LSideword)
    If Dt = 0 Then
      Extex = "err.0"
       GoTo fend
    End If
  
   Dt = Mid(Origin, Dt + Len(LSideword), Len(Origin))
    Extex = Dt
    
     Dt = InStr(Extex, RSideword)
      If Dt = 0 Then
        Extex = "err.1"
         GoTo fend
      End If
      
Extex = Mid(Extex, 1, Dt - 1)
GoTo fend

ferr:
Extex = "err.2"

fend:
End Function

[ツリー表示へ]
タイトルRe: エラー処理追加(修正)
記事No14251
投稿日: 2009/11/12(Thu) 14:24
投稿者へへへ
わざわざ文字列と添え字でめんどくさくやらなくても、
開始指定文字列でsplitして配列aを作り、
Ubound(配列a) > 0だったら、配列a(1)を終了指定文字で再度splitして配列bを作成すれば、
Ubound(配列b) > 0のとき、配列b(1)が、欲しい文字列になりませんか?

[ツリー表示へ]
タイトルRe^2: エラー処理追加(修正)
記事No14252
投稿日: 2009/11/12(Thu) 20:10
投稿者花ちゃん
> Ubound(配列b) > 0のとき、配列b(1)が、欲しい文字列になりませんか?

なりませんか? と問われるなら、[なりません]と答えておきます。

[ツリー表示へ]
タイトルRe^3: エラー処理追加(修正)
記事No14257
投稿日: 2009/11/13(Fri) 10:12
投稿者GOD
> > Ubound(配列b) > 0のとき、配列b(1)が、欲しい文字列になりませんか?
>
> なりませんか? と問われるなら、[なりません]と答えておきます。
>
へへへ さん の言う通りのプログラム書いてみました。
花ちゃんの言う通りならないし、 仮に正しく修正(?)したとしても S.Eleven さんのもの
と違う結果が返されることがありますね。(どちらの結果が望ましいかはわかりませんが)

Private Sub Command1_Click()
    Debug.Print Extex("ABCD1234EFG", "ABCD", "EFG")
    Debug.Print Extex2("ABCD1234EFG", "ABCD", "EFG")
    '開始文字〜終了文字の間に開始文字が含まれてしまっている場合
    Debug.Print Extex("ABCD1ABCD234EFG", "ABCD", "EFG")
    Debug.Print Extex2("ABCD1ABCD234EFG", "ABCD", "EFG")
End Sub

'Ubound(配列a) > 0だったら、配列a(1)を終了指定文字で再度splitして配列bを作成す
'れば、Ubound(配列b) > 0のとき、配列b(1)が、欲しい文字列になりませんか?
Public Function Extex2(Origin As Variant, LSideword As String, RSideword As String) As Variant
    Dim sSplit() As String
    Dim sRet As String

    sSplit = Split(Origin, LSideword)  '配列a作成
    If UBound(sSplit) > 0 Then
        sSplit = Split(sSplit(1), RSideword)  '配列b作成
        If UBound(sSplit) > 0 Then
            sRet = sSplit(1)    'ここは多分 0だと思うが。
        End If
    End If
    Extex2 = sRet
End Function

[ツリー表示へ]
タイトルRe^4: エラー処理追加(修正)
記事No14258
投稿日: 2009/11/13(Fri) 12:02
投稿者S.Eleven
へへへさん花ちゃんさんGODさん、わざわざありがとうございます。
一応最後に(?)ですが、この関数の引数を
("ABCD123EFG","CD","EF")
としても正常に切り取ることが出来ます。
大切な部分を言い忘れていました

[ツリー表示へ]
タイトルRe^5: エラー処理追加(修正)
記事No14264
投稿日: 2009/11/13(Fri) 15:03
投稿者YK
こんにちは。

私もサンプルで

Function Extex3(strM As String, strA As String, strB As String)
    Dim v1  As Variant
    Dim v2  As Variant
    Dim i   As Long
    Dim j   As Long
    
    v1 = Split(strM, strA)
    If UBound(v1) > 0 Then
        For i = 0 To UBound(v1)
            If v1(i) Like "*" & strB & "*" Then
                v2 = Split(v1(i), strB)
                Extex3 = v2(0)
                Exit For
            End If
        Next
        If i = (UBound(v1) + 1) Then Extex3 = strM
    Else
        Extex3 = strM
    End If
End Function

[ツリー表示へ]
タイトルRe^6: エラー処理追加(修正)
記事No14265
投稿日: 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
あいうえ

[ツリー表示へ]
タイトルRe^7: エラー処理追加(修正)
記事No14266
投稿日: 2009/11/13(Fri) 17:07
投稿者YK
こんにちは。

> > 私もサンプルで
>
> 下記ならどのようになりますか?
> Debug.Print Extex3("ABSCD1234EFG", "ABCD", "EFG")
> Debug.Print Extex3("ABSCD1234EFGABCD123EFG", "ABCD", "EFG")

そうでね。
考えてみたら

V1 = Split("ABSCD1234EFGABCD123EFG", "ABCD")の時
V1(0)にEFGがあっても無視ですね。

>    v1 = Split(strM, strA)
>    If UBound(v1) > 0 Then
>        For i = 0 To UBound(v1)
          ↓ でどうでしょう。
        For i = 1 To UBound(v1)

[ツリー表示へ]
タイトルRe^8: エラー処理追加(修正)
記事No14268
投稿日: 2009/11/13(Fri) 17:36
投稿者花ちゃん
> >        For i = 0 To UBound(v1)
>           ↓ でどうでしょう。
>         For i = 1 To UBound(v1)

見つからなかった場合の処理も不十分ですね。

Debug.Print Extex3("ABSCD1234EFG", "ABCD", "EFG")
Debug.Print Extex3("ABCD1234EGFG", "ABCD", "EFG")

[ツリー表示へ]
タイトルRe^9: エラー処理追加(修正)
記事No14269
投稿日: 2009/11/13(Fri) 17:54
投稿者YK
こんにちは。

> 見つからなかった場合の処理も不十分ですね。
>
> Debug.Print Extex3("ABSCD1234EFG", "ABCD", "EFG")
> Debug.Print Extex3("ABCD1234EGFG", "ABCD", "EFG")

見つからなかった場合の処理は全文字を返していました。
もし""を送るなら
Extex3 = strM の部分を Extex3 = "" に変更すれば宜しいかと思います。

[ツリー表示へ]