TEST
Sub test()
Dim sArr() As String
sArr = getStrToArr("12345", 1)
Dim iArr() As Integer
iArr = getStrToAsciiArr("ABCD")
sArr = getAsciiToChrArr(iArr)
iArr = getStrToUnicodeArr("ABCD")
sArr = getUnicodeToChrArr(iArr)
Dim s As String
s = "123456789"
Debug.Print getInstrPrevOrFol(s, "6", "FWD", "PREV")
Debug.Print getInstrPrevOrFol(s, "6", "FWD", "FOL")
Debug.Print getInstrPrevOrFol(s, "6", "REV", "PREV")
Debug.Print getInstrPrevOrFol(s, "6", "REV", "FOL")
s = "12355894785125969"
Debug.Print getStrCount(s, "9")
Debug.Print getStrRepeat("9", 10)
Debug.Print getIsStrLike("ABCDE", "???")
Debug.Print getIsStrLike("123456", "??????")
Debug.Print getIsStrLike("ABCDE", "#####")
Debug.Print getIsStrLike("12345", "#####")
Debug.Print getIsStrLike("12345", "?[1-2]*")
Debug.Print getIsStrLike("12345", "?[!1-2]*")
Debug.Print getIsRegExp("1234567", "?[!1-2]*")
End Sub
文字列を指定文字数で分割して配列で返す
Public Function getStrToArr( _
ByVal argTrgStr As String, _
ByVal argLen As Long _
) As String()
Dim sArr() As String
Dim iIdx As Long
iIdx = 0
ReDim sArr(0 To Application.WorksheetFunction.RoundDown(Len(argTrgStr) / argLen - 0.5, 0))
Dim i As Long
For i = 1 To Len(argTrgStr) Step argLen
sArr(iIdx) = Mid(argTrgStr, i, argLen)
iIdx = iIdx + 1
Next
getStrToArr = sArr
End Function
文字列をASCII変換して配列で返す
Public Function getStrToAsciiArr( _
ByVal argTrgStr As String _
) As Integer()
Dim i As Long
Dim resArr() As Integer
Dim sArr() As String
sArr = getStrToArr(argTrgStr, 1)
ReDim resArr(UBound(sArr))
For i = LBound(sArr) To UBound(sArr)
resArr(i) = Asc(sArr(i))
Next i
getStrToAsciiArr = resArr
End Function
Public Function getStrToUnicodeArr( _
ByVal argTrgStr As String _
) As Integer()
Dim i As Long
Dim resArr() As Integer
Dim sArr() As String
sArr = getStrToArr(argTrgStr, 1)
ReDim resArr(UBound(sArr))
For i = LBound(sArr) To UBound(sArr)
resArr(i) = AscW(sArr(i))
Next i
getStrToUnicodeArr = resArr
End Function
ASCII配列を文字列変換して配列で返す
Public Function getAsciiToChrArr( _
argTrgAscii() As Integer _
) As String()
Dim i As Long
Dim resArr() As String
ReDim resArr(LBound(argTrgAscii) To UBound(argTrgAscii))
For i = LBound(argTrgAscii) To UBound(argTrgAscii)
resArr(i) = Chr(argTrgAscii(i))
Next i
getAsciiToChrArr = resArr
End Function
Public Function getUnicodeToChrArr( _
argTrgAscii() As Integer _
) As String()
Dim i As Long
Dim resArr() As String
ReDim resArr(LBound(argTrgAscii) To UBound(argTrgAscii))
For i = LBound(argTrgAscii) To UBound(argTrgAscii)
resArr(i) = ChrW(argTrgAscii(i))
Next i
getUnicodeToChrArr = resArr
End Function
文字列を検索して、前or後を返す
Public Function getInstrPrevOrFol( _
ByVal argTrgStr As String, _
ByVal argSrhStr As String, _
ByVal argSrhDirection As String, _
ByVal argGetPrevOrFol As String _
) As String
Dim sRes As String
Select Case argSrhDirection
Case "FWD"
Select Case argGetPrevOrFol
Case "PREV": sRes = Mid(argTrgStr, 1, InStr(argTrgStr, argSrhStr) - 1)
Case "FOL": sRes = Mid(argTrgStr, InStr(argTrgStr, argSrhStr) + 1)
Case Else: Stop
End Select
Case "REV": sRes = Mid(argTrgStr, InStrRev(argTrgStr, argSrhStr) + 1)
Select Case argGetPrevOrFol
Case "PREV": sRes = Mid(argTrgStr, 1, InStrRev(argTrgStr, argSrhStr) - 1)
Case "FOL": sRes = Mid(argTrgStr, InStrRev(argTrgStr, argSrhStr) + 1)
Case Else: Stop
End Select
Case Else
Stop
End Select
getInstrPrevOrFol = sRes
End Function
指定文字の個数を返す
Public Function getStrCount( _
ByVal argTrgStr As String, _
ByVal argSrhStr As String _
) As Long
Dim iCnt As Long
Dim iFndFlg As Long
iFndFlg = InStr(1, argTrgStr, argSrhStr)
Do While iFndFlg > 0
iCnt = iCnt + 1
iFndFlg = InStr(iFndFlg + 1, argTrgStr, argSrhStr)
Loop
getStrCount = iCnt
End Function
指定文字を繰り返す
Public Function getStrRepeat( _
ByVal argRptChar As String, _
ByVal argRptNum As Long _
) As String
If Len(argRptChar) <> 1 Then Stop
getStrRepeat = String(argRptNum, argRptChar)
End Function
パターンマッチング:LIKE
Public Function getIsStrLike( _
ByVal argTrgStr As String, _
ByVal argPtn As String _
) As Boolean
getIsStrLike = argTrgStr Like argPtn
End Function
パターンマッチング:正規表現
Public Function getIsRegExp( _
ByVal argTrg As String, _
ByVal argPtn As String _
) As Boolean
If argTrg = "" Or argPtn = "" Then
getIsRegExp = False
Exit Function
End If
Dim bRes As Boolean
Dim strPattern As String
Dim opjRegExp As RegExp
Set opjRegExp = CreateObject("VBScript.RegExp")
With opjRegExp
.Pattern = argPtn
.IgnoreCase = True
.Global = True
End With
bRes = opjRegExp.test(argTrg)
getIsRegExp = IIf(bRes, True, False)
End Function
| B | C | D | | | |
| | | ..(BD|EF)....... | | | |
7 | TRG | PTN | RES | | | |
8 | ABCDEFGHIJK | ..(CD|EF)....... | 1 | | | |
9 | ABCDEFGHIJK | ..(CD|EF)....... | 1 | | | |
… | | | | | | |
Sub Sample()
Dim arr(0 To 20000) As Long
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets(1)
Dim i As Long
Dim sTrg As String
Dim sPtn As String
For i = LBound(arr) To UBound(arr)
DoEvents
sTrg = ws.Cells(7 + i, "B").Value
sPtn = ws.Cells(7 + i, "C").Value
arr(i) = myFncRegExp(sTrg, sPtn)
Next i
ws.Range(Cells(7, "D"), Cells(7 + UBound(arr), "D")) = WorksheetFunction.Transpose(arr)
End Sub
Public Function myFncRegExp( _
ByVal argTrg As String, _
ByVal argPtn As String _
) As Integer
If argTrg = "" Then
myFncRegExp = -1
Exit Function
End If
Dim bRes As Boolean
Dim RE, strPattern As String
Set RE = CreateObject("VBScript.RegExp")
With RE
.Pattern = argPtn
.IgnoreCase = True
.Global = True
bRes = .Test(argTrg)
End With
myFncRegExp = IIf(bRes, 1, 0)
End Function