[转] ACCESS 97 类似 replace 及 split 函數
Function replace(ByVal sstr As String, ByVal stag As String, ByVal srep As String) As String
Dim l1, l2, l3, x, i As Long
Dim st As String
x = InStr(sstr, stag)
If x < 1 Then
replace = sstr
Exit Function
End If
st = sstr
l1 = Len(sstr)
l2 = Len(stag)
l3 = Len(srep)
For i = 0 To l1
st = Left(st, x - 1) & srep & Right(st, Len(st) - x - l2 + 1)
x = InStr(x + l3, st, stag)
If x < 1 Then Exit For
Next
replace = st
End Function
Dim l1, l2, l3, x, i As Long
Dim st As String
x = InStr(sstr, stag)
If x < 1 Then
replace = sstr
Exit Function
End If
st = sstr
l1 = Len(sstr)
l2 = Len(stag)
l3 = Len(srep)
For i = 0 To l1
st = Left(st, x - 1) & srep & Right(st, Len(st) - x - l2 + 1)
x = InStr(x + l3, st, stag)
If x < 1 Then Exit For
Next
replace = st
End Function
Function split(ByVal sstr As String, ByVal spstr As String) As Variant
Dim star, lenstr, lensp, cur As Integer
Dim backstr() As String
Dim i As Integer
ReDim backstr(0)
lenstr = Len(sstr)
lensp = Len(spstr)
star = InStr(sstr, spstr)
If star < 1 Then
backstr(0) = sstr
split = backstr()
Exit Function
End If
backstr(0) = Left(sstr, star - 1)
cur = star + lensp
For i = star + lensp To lenstr
star = InStr(star + lensp, sstr, spstr)
If star > 0 Then
ReDim Preserve backstr(UBound(backstr) + 1)
backstr(UBound(backstr)) = Mid(sstr, cur, star - cur)
cur = star + lensp
Else
Exit For
End If
Next
ReDim Preserve backstr(UBound(backstr) + 1)
backstr(UBound(backstr)) = Mid(sstr, cur, lenstr - cur + 1)
split = backstr()
End Function
Dim star, lenstr, lensp, cur As Integer
Dim backstr() As String
Dim i As Integer
ReDim backstr(0)
lenstr = Len(sstr)
lensp = Len(spstr)
star = InStr(sstr, spstr)
If star < 1 Then
backstr(0) = sstr
split = backstr()
Exit Function
End If
backstr(0) = Left(sstr, star - 1)
cur = star + lensp
For i = star + lensp To lenstr
star = InStr(star + lensp, sstr, spstr)
If star > 0 Then
ReDim Preserve backstr(UBound(backstr) + 1)
backstr(UBound(backstr)) = Mid(sstr, cur, star - cur)
cur = star + lensp
Else
Exit For
End If
Next
ReDim Preserve backstr(UBound(backstr) + 1)
backstr(UBound(backstr)) = Mid(sstr, cur, lenstr - cur + 1)
split = backstr()
End Function
AC97でそれらしい関数を作ってみました。
【関数例】
Public Function Replace97(varStrings As Variant, varBeforeChr As Variant, varAfterChr As Variant) As Variant
'----( 変数宣言 )----------------------------------------------
Dim lngX1 As Long
'----( 初期設定 )----------------------------------------------
Replace97 = varStrings
'----( 置換処理 )----------------------------------------------
If IsNull(varStrings) Or varStrings = "" Then
Else
If IsNull(varBeforeChr) Or varBeforeChr = "" Then
Else
Replace97 = ""
For lngX1 = 1 To Len(varStrings)
If Mid(varStrings, lngX1, Len(varBeforeChr)) = varBeforeChr Then
Replace97 = Replace97 & varAfterChr
lngX1 = lngX1 + Len(varBeforeChr) - 1
Else
Replace97 = Replace97 & Mid(varStrings, lngX1, 1)
End If
Next lngX1
End If
End If
End Function
'----( 変数宣言 )----------------------------------------------
Dim lngX1 As Long
'----( 初期設定 )----------------------------------------------
Replace97 = varStrings
'----( 置換処理 )----------------------------------------------
If IsNull(varStrings) Or varStrings = "" Then
Else
If IsNull(varBeforeChr) Or varBeforeChr = "" Then
Else
Replace97 = ""
For lngX1 = 1 To Len(varStrings)
If Mid(varStrings, lngX1, Len(varBeforeChr)) = varBeforeChr Then
Replace97 = Replace97 & varAfterChr
lngX1 = lngX1 + Len(varBeforeChr) - 1
Else
Replace97 = Replace97 & Mid(varStrings, lngX1, 1)
End If
Next lngX1
End If
End If
End Function
※置換開始位置や置換回数などのパラメータは、考慮していません。
【確認】
Public Function TEST()
MsgBox Replace97("ABC", "BC", "") → A
MsgBox Replace97("ABCD", "BC", "") → AD
MsgBox Replace97("ABCDABCDBC", "BC", "") → ADAD
MsgBox Replace97("ABCDABCDBC", "BC", "XY") → AXYDAXYDXY
End Function
MsgBox Replace97("ABC", "BC", "") → A
MsgBox Replace97("ABCD", "BC", "") → AD
MsgBox Replace97("ABCDABCDBC", "BC", "") → ADAD
MsgBox Replace97("ABCDABCDBC", "BC", "XY") → AXYDAXYDXY
End Function