- 日時: 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
|