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
【戻る】