VB かなりどうでもいい関数

JavaScriptのページになんですが、VBの関数。ギャグ無しです。
ギャグみたいな動作したらそれはギャグではなくバグです
えあの個人的なメモとして残しておくものですが、ご入用ならどうぞ。不具合発生による責は負いません。

全置換 Replace() 配列から文字列検索 SearchArray() 文字を無視CInt CIntAd() 似非配列 FakeArray() タグ削除 RemoveTag() AからBまで取得 BetweenAandB()

'====================================================================
'全置換
'引数   文字列str中のaをbに変換(VB5以前。6にはあります)
'戻り値 変換後の文字列
'====================================================================
Public Function Replace(str As String, A As String, B As String)
    Dim tmp As String
    Dim hajime As Variant
    Dim hakken As Variant
    hajime = 1
    hakken = 1
    
    Do
        hakken = InStr(hajime, str, A)
        If hakken = 0 Then
            tmp = tmp & Mid(str, hajime)
            Exit Do
        End If
        tmp = tmp & Mid(str, hajime, hakken - hajime)
        tmp = tmp & B
        hajime = hakken + Len(A)
    Loop
    Replace = tmp
End Function


'====================================================================
'配列から検索。
'引数   配列ary中から文字列strを含む要素を捜す
'       after…ary(after)以降でstrを捜す
'戻り値 要素番号。ないとき-1
'====================================================================
Public Function SearchArray(str As String, ary() As String, Optional after As Integer)
    Dim i As Integer
    SearchArray = -1
    
    For i = 0 + after To UBound(ary)
        If ary(i) = str Then
            SearchArray = i
            Exit For
        End If
    Next
End Function


'====================================================================
'文字は無視するCInt。
'引数   expをInteger型に変換
'戻り値 変換後
'====================================================================
Public Function CIntAd(exp)
    Dim tmp As String
    Dim i As Integer
    
    For i = 1 To Len(exp)
        If Mid(exp, i, 1) >= "0" And Mid(exp, i, 1) <= "9" Then tmp = tmp & Mid(exp, i, 1)
    Next
    
    tmp = CInt(tmp)
    
    CIntAd = tmp
    
End Function


'====================================================================
'似非配列。カンマで区切られた文字列の指定番目を取得。0番目から。
'引数   カンマで区切られた文字列str。取り出したい番号no
'戻り値 取り出した文字列。
'ex)  a=FakeArray("aaa,bbb,ccc,ddd",2)    a="ccc"
'====================================================================
Public Function FakeArray(str As String, no As Integer)
    Dim hajime As Integer: hajime = 1
    Dim hakken As Integer: hakken = 1
    Dim tmp As String: tmp = ""
    Dim cnt As Integer: cnt = 0

    Do
        hakken = InStr(hajime, str, ",")
        If no = cnt Then
            tmp = Mid(str, hajime)
            If InStr(tmp, ",") > 0 Then tmp = Mid(tmp, 1, InStr(tmp, ",") - 1)
            Exit Do
        End If
        If hakken = 0 Then Exit Do
        hajime = hakken + 1
        cnt = cnt + 1
    Loop
    FakeArray = tmp
    
End Function


'====================================================================
'タグ削除。文字列中のHTMLタグを削除。ちょっと")
        If hakkenend = 0 Then
            tmp = tmp & Mid(str, cursor)
            Exit Do
        End If
        cursor = hakkenend + 1
    Loop
    RemoveTag = tmp
    
    
End Function


'====================================================================
'BetweenAandB Aと、Aから後ろで最初のBまでを取得
'引数   str中のAからBまでを取得。
'戻り値 取得した文字列。AとBも含みます
'       Aが見つからない時 ""
'       Bが見つからない時 Aから最後まで
'ex) a=BetweenAandB("abcdefgh", "b", "fg")   a="bcdefg"
'====================================================================
Public Function BetweenAandB(str As String, A As String, B As String)
    Dim tmpstr As String
    Dim max As Integer
    
    If InStr(str, A) = 0 Then Exit Function
    
    tmpstr = Mid(str, InStr(str, A))
    
    max = IIf(InStr(tmpstr, B) = 0, Len(str), InStr(tmpstr, B) + Len(B) - 1)

    tmpstr = Left(tmpstr, max)
    
    BetweenAandB = tmpstr
End Function


【戻る】