プログラミングのメモ

プログラミングの学び直し備忘録

VBA:Excel:文字列操作

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]*")
  
  

    '------+------------------------------------------
    'title | title
    '------+------------------------------------------
    '  ^   | 文字列の先頭
    '------+------------------------------------------
    '  $   | 文字列の末尾
    '------+------------------------------------------
    '  \n  | 改行
    '------+------------------------------------------
    '  .   | 改行を除く任意の1文字
    '------+------------------------------------------
    '  *   | 直前のパターンの0回以上の繰り返し
    '------+------------------------------------------
    '  +   | 直前のパターンの1回以上の繰り返し
    '------+------------------------------------------
    '  ?   | 直前のパターンが0回または1回現れる
    '------+------------------------------------------
    '  \d  | 任意の数値
    '------+------------------------------------------
    '  \D  | 任意の数値以外の文字
    '------+------------------------------------------
    '  \s  | 任意のスペース文字
    '------+------------------------------------------
    '  \S  | 任意のスペース以外の文字
    '------+------------------------------------------
    '  ()  | パターンのグループ化
    '------+------------------------------------------
    '  |   | パターンの論理和
    '------+------------------------------------------
    '  []  | キャラクタクラス
    '------+------------------------------------------
'  '//  http://officetanaka.net/excel/vba/tips/tips38.htm
  Debug.Print getIsRegExp("1234567", "?[!1-2]*")
  

End Sub

文字列を指定文字数で分割して配列で返す

'*****************************************************************
'* 文字列を指定文字数で分割して配列で返す
'*
'* ARG01
'* ARG02
'*
'* 戻り値
'*
'*****************************************************************
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変換して配列で返す

'*****************************************************************
'* 文字列をASCII変換して配列で返す
'*
'* ARG01
'* ARG02
'*
'* 戻り値
'*
'*****************************************************************
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

文字列をUnicode(UTF-16)変換して配列で返す

'*****************************************************************
'* 文字列をUnicode(UTF-16)変換して配列で返す
'*
'* ARG01
'* ARG02
'*
'* 戻り値
'*
'*****************************************************************
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配列を文字列変換して配列で返す

'*****************************************************************
'* ASCII配列を文字列変換して配列で返す
'*
'* ARG01
'* ARG02
'*
'* 戻り値
'*
'*****************************************************************
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

Unicode(UTF-16)配列を文字列変換して配列で返す

'*****************************************************************
'* Unicode(UTF-16)配列を文字列変換して配列で返す
'*
'* ARG01
'* ARG02
'*
'* 戻り値
'*
'*****************************************************************
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後を返す

'*****************************************************************
'* 文字列を検索して、前or後を返す
'*
'* ARG01
'* ARG02
'* ARG03 : 検索方向   [FWD]Forword  or [REV]Reverse
'* ARG04 : 取得文字列 [PRV]Previous or [FOL]Following
'*
'* 戻り値
'*
'*****************************************************************
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

指定文字の個数を返す

'*****************************************************************
'* 指定文字の個数を返す
'*
'* ARG01
'* ARG02
'*
'* 戻り値
'*
'*****************************************************************
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

指定文字を繰り返す

'*****************************************************************
'* 指定文字を繰り返す
'*
'* ARG01
'* ARG02
'*
'* 戻り値
'*
'*****************************************************************
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

'*****************************************************************
'* パターンマッチング:LIKE
'*
'* ARG01
'* ARG02
'*
'* 戻り値
'*
'*****************************************************************
Public Function getIsStrLike( _
                                    ByVal argTrgStr As String, _
                                    ByVal argPtn As String _
                                    ) As Boolean
                                      
    getIsStrLike = argTrgStr Like argPtn
    
End Function

パターンマッチング:正規表現

'*****************************************************************
'* パターンマッチング:正規表現
'*
'* ARG01
'* ARG02
'*
'* 戻り値
'*
'*****************************************************************
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          ''文字列全体を検索 (最初の一致だけを検索する場合は、False(既定値))
    End With
        
    bRes = opjRegExp.test(argTrg)
    
'    getIsRegExp = IIf(bRes, 1, 0)
    getIsRegExp = IIf(bRes, True, False)
    

End Function