プログラミングのメモ

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

VBA:Excel:コレクション

注意

'Collectionに対して以下のように処理すると、
'後ろの要素に行くにしたがってより処理時間がかかってしまうようになります。
'Dim i As Long
'For i = 1 To colls.Count
'    Debug.Print colls(1)
'Next
'コレクションのメモリ構造がチェーンのように次々につながっている事に起因します。
'コレクション対して全件処理する場合は、次回説明するFor Eachを使って以下のように処理してください。
' https://excel-ubara.com/excelvba1/EXCELVBA358.html

TEST

Public Sub aTEST_Collection()

  '===========================================================
  '【遅延バインディング】
  '  Dim Dictionary名 As Object
  '  Set Dictionary名 = CreateObject("Scripting.Dictionary")
  '===========================================================


  '=====================================================
  '// 追加・カウント・削除・取得・KEY存在確認
  '=====================================================
  Dim colc01 As Collection
  Set colc01 = New Collection
  
'// 追加
'//   object.Add item, key, before, afte
  colc01.Add "VAL", "KEY"
  colc01.Add "AAAA", "a"     'Add some keys and items
  colc01.Add "BBBB", "b"
  colc01.Add "CCCC", "c"
  colc01.Add "DDDD"
  
'// カウント
  Debug.Print colc01.Count          '// カウント
  
'// 取得
  Debug.Print colc01("KEY")
  Debug.Print colc01("a")
        
  Dim vFE As Variant
  For Each vFE In colc01
      Debug.Print vFE
  Next vFE
        
'// IsExists
  
'// Remove
  colc01.Remove "b"
  For Each vFE In colc01
      Debug.Print vFE
  Next vFE
  
  colc01.Remove 1
  For Each vFE In colc01
      Debug.Print vFE
  Next vFE

  Call getRemoveAll(colc01)

'//


End Sub

要素存在確認

'*****************************************************************
'* 要素存在確認
'*
'* ARG 01 : 対象Collection
'* ARG 02 : Collectionの要素
'* 戻り値 :
'*
'*****************************************************************
Function getColcIsExists( _
                            colc As Collection, _
                            vItem As Variant _
                            ) As Boolean
  Dim vFE As Variant
  For Each vFE In colc
    If vFE = vItem Then
      getColcIsExists = True
      Exit Function
    End If
  Next vFE
  
  getColcIsExists = False
    
End Function

Collection → クリア

'*****************************************************************
'* Collection → クリア
'*
'* ARG 01 : 対象Collection
'* 戻り値 :
'*
'*****************************************************************
Public Sub getColcRemoveAll( _
                            ByRef colc As Collection _
                            )
  
  Dim i As Long
  For i = 1 To colc.Count
    colc.Remove 1
  Next i
    
End Sub

Collection → 配列

'*****************************************************************
'* Collection → 配列
'*
'* ARG 01 : 対象Collection
'* 戻り値 :
'*
'*****************************************************************
Public Function getCollectToArray( _
                                  ByVal colTrg As Collection _
                                  ) As Variant

  Dim vRes As Variant
  ReDim vRes(colTrg.Count - 1)
 
  Dim i As Long
  i = LBound(vntResult)
  
  Dim vFE As Variant
  For Each vFE In colTrg
    vntResult(i) = vFE
    i = i + 1
  Next vFE
 
  getCollectToArray = vRes
  
End Function

VBA:Excel:配列とセル

aTEST_Array

Sub aTEST_Array()
    
  Dim arr()

'==================================
'/// 配列の配列を2次元配列で返す
'==================================
  Dim vArrOfArr(2)

  vArrOfArr(0) = Array("01", "02", "03", "04", "05")
  vArrOfArr(1) = Array("11", "12", "13", "14", "15")
  vArrOfArr(2) = Array("21", "22", "23", "24", "25")
'  vArrOfArr(3) = Array("21", "22", "23", "24")
  
    
  '// 配列の配列から2次元配列
  Dim vRes_Arr2d()
  vRes_Arr2d = getArrayOfArrayToArr(vArrOfArr)

  arr() = getArrConvArray2dTo1d(vRes_Arr2d)

'==================================
'/// クイックソート
'==================================
  arr() = Array(1, 51, 4, 8, 5, 45, 3, 8)
  
  Dim vResArr()
  vResArr = getArrSortQuick(arr(), LBound(arr), UBound(arr))

'==================================
'/// 重複削除
'==================================
  arr() = Array(1, 1, 1, 4, 8, 5, 4, 3)
  vResArr = getArrDelSameVal(arr())
  vResArr = getArrSortQuick(vResArr(), LBound(vResArr), UBound(vResArr))

'==================================
'// 配列かどうか/空かどうか確認
'==================================
  Dim lRes As Long
  
  '// 配列でない : -1
  Dim vNotArr
  lRes = getArrIsExists(vNotArr)
  
  '// 空の配列 : 0
  Dim vArr()
  lRes = getArrIsExists(vArr)
  
  '// 配列 : 1
  vArr = Array("a", 1)
  lRes = getArrIsExists(vArr)

'==================================
'* 配列の次元数を取得する
'==================================
  Debug.Print getArrDimension(vResArr)
  Debug.Print getArrDimension(vRes_Arr2d)
  Debug.Print getArrDimension(vArrOfArr)
    
'==================================
'* 配列の最大値取得
'==================================
  Debug.Print getArrMax(Array(3, 5, 1, 466, 7, 5, 333))
  
  vArrOfArr(0) = Array(3, 5, 7, 2, 4)
  vArrOfArr(1) = Array(43, 55, 67, 22, 14)
  vArrOfArr(2) = Array(3, 45, 7, 2, 4)
  Debug.Print getArrMax(vArrOfArr)
  
  vRes_Arr2d = getArrayOfArrayToArr(vArrOfArr)
  Debug.Print getArrMax(vRes_Arr2d)


End Sub

aTEST2_Array

'2次元配列で1行を配列で取得
'2次元配列で1列を配列で取得
Sub aTEST2_Array()

    Dim Array1D As Variant '一次元配列
'    Dim Array2D(1, 2) As Variant '二次元配列
    Dim Array2D(2, 2) As Variant '二次元配列
 
    If Call_arrDimensionCheck(Array2D) <> 2 Then Exit Sub
    
    Array2D(0, 0) = 1: Array2D(0, 1) = 2: Array2D(0, 2) = 3:
    Array2D(1, 0) = 11: Array2D(1, 1) = 12: Array2D(1, 2) = 13:
    Array2D(2, 0) = 1: Array2D(2, 1) = 2: Array2D(2, 2) = 3:
 
    
    Dim rsArr
    rsArr = getArrConv2dTo1dAtIndexNo(Array2D, "ROW", 1)
    rsArr = getArrConv2dTo1dAtIndexNo(Array2D, "ROW", 2)
    
    rsArr = getArrConv2dTo1dAtIndexNo(Array2D, "COL", 1)
    rsArr = getArrConv2dTo1dAtIndexNo(Array2D, "COL", 2)
    rsArr = getArrConv2dTo1dAtIndexNo(Array2D, "COL", 3)
    
    rsArr = getArrConv2dTo1dAtIndexNo(Array(1, 2, 3), "ROW", 1)
    rsArr = getArrConv2dTo1dAtIndexNo(Array(1, 2, 3), "COL", 3)
    
'%%%%%%%%%%%%%%%%%%%%%
    Dim ws As Worksheet: Set ws = ActiveSheet
    ws.Cells.ClearContents
  
    'Variant型動的配列の宣言
    Dim vArr() As Variant
    
    '配列の要素をシートのセルにセット
    vArr = Array(1, 2, 3, 4, 5)
    Dim rngStartCell As Range
    Set rngStartCell = ws.Range("A1")
    Call mth_SetCell1DArr(vArr, rngStartCell, "H")
    
'    vArr = Array(21, 22, 23, 24, 25)
'    Set rngStartCell = ws.Range("A2")
'    Call mth_SetCell1DArr(vArr, rngStartCell, "H")
    
    Dim myrange As Range
    Set myrange = rngStartCell.CurrentRegion
    myrange.Select
    
    vArr = myrange
    rsArr = getArrConv2dTo1dAtIndexNo(vArr, "COL", 3)
    rsArr = getArrConv2dTo1dAtIndexNo(vArr, "ROW", 1)
    
End Sub

aTEST_CellArray

Sub aTEST_CellArray()

    Dim vArr1D()
    vArr1D = Array(1, 3, 5, 4, 2)
    
    '// 出力
    ActiveSheet.Cells.ClearContents
    Call mth_SetCell1DArr(vArr1D, Range("B2"), "H")
    
    ActiveSheet.Cells.ClearContents
    Call mth_SetCell1DArr(vArr1D, Range("B2"), "V")
    

'///
    '// 出力データ生成
    Dim vArr(2, 5) As Variant
    
    Dim r As Long, c As Long
    For r = LBound(vArr, 1) To UBound(vArr, 1)
        For c = LBound(vArr, 2) To UBound(vArr, 2)
            vArr(r, c) = CStr(r) & CStr(c)
        Next c
    Next r
    
    '// 出力
    ActiveSheet.Cells.ClearContents
    Call setArr2dToRng(vArr, Range("B2"))

'///
  Dim vResArr
  vResArr = getRngToArr2d(Range("B2").CurrentRegion)

'=====================================================================
'/// 指定行範囲、指定列番号リストのセル値を配列の配列で返す
'=====================================================================
    '// 対象行範囲
    Dim lRowStartEnd(1) As Long
    lRowStartEnd(0) = 3: lRowStartEnd(1) = 8    '3:8行
    
    '// 抽出列
    Dim lColNos(3) As Long
    lColNos(0) = 2
    lColNos(1) = 3
    lColNos(2) = 5
    lColNos(3) = Columns("G").Column
    
    '// 配列の配列データ取得
    Dim vRes_ArrOfArr()
    vRes_ArrOfArr = mth_GetCellVal_ArrOfArr(ActiveSheet, lRowStartEnd, lColNos)

End Sub

aTest2

Sub aTest2()

  Dim r, c
  Dim arr As Variant
  
  arr = Range(Cells(1, 1), Cells(11, 5))
  
  For r = LBound(arr, 1) To UBound(arr, 1)
    For c = LBound(arr, 2) To UBound(arr, 2)
      arr(r, c) = StrConv(arr(r, c), vbUpperCase)
    Next c
  Next r
  
  Call mod_CellArr.setArr2dToRng(arr, Range("A1"))

End Sub

配列の配列 → 2次元配列

'*****************************************************************
'* 配列の配列 → 2次元配列
'*  配列の配列を2次元配列で返す(配列内の配列要素数は同じであること)
'*
'* ARG 01 : 配列の配列
'* ARG 02 : 出力開始セル
'* 戻り値 : 2次元配列
'*
'* 説明   : 配列内の配列は、1次元。
'*            先頭配列の要素数に合わせる
'*
'*****************************************************************
Public Function getArrayOfArrayToArr( _
                                        vArrayOfArray As Variant _
                                        ) As Variant
        
  Dim iColNum As Long
  iColNum = UBound(vArrayOfArray(LBound(vArrayOfArray)))
  
  Dim r As Long, c As Long
  
  
  '//
  Dim vRes_2dArr()
  
  ReDim vRes_2dArr(UBound(vArrayOfArray), iColNum)
  
  For r = LBound(vArrayOfArray) To UBound(vArrayOfArray)    '// 1段目配列(行)
    If UBound(vArrayOfArray(r)) <> iColNum Then
      getArrayOfArrayToArr = Array()
      Exit Function
    End If
    
    For c = LBound(vArrayOfArray(r)) To UBound(vArrayOfArray(r))  '// 2段目配列(列)
      vRes_2dArr(r, c) = vArrayOfArray(r)(c)
    Next
  Next
  
  getArrayOfArrayToArr = vRes_2dArr
    
End Function

クイックソート

'*****************************************************************
'* クイックソート
'*
'* ARG 01 : 対象配列
'* ARG 02 : LBound(対象配列)
'* ARG 03 : UBound(対象配列)
'* 戻り値 : 配列
'*
'* 説明   : 配列内の配列は、1次元。
'*            先頭配列の要素数に合わせる
'*
'*****************************************************************
Public Function getArrSortQuick( _
                                ByRef vargArr() As Variant, _
                                ByVal lngMin As Long, _
                                ByVal lngMax As Long _
                                ) As Variant()
    Dim i As Long, j As Long
    Dim vBase As Variant
    Dim vSwap As Variant
    
    vBase = vargArr(Int((lngMin + lngMax) / 2))
    i = lngMin
    j = lngMax
    
    Do
        Do While vargArr(i) < vBase
            i = i + 1
        Loop
        
        Do While vargArr(j) > vBase
            j = j - 1
        Loop
        
        If i >= j Then Exit Do
        
        vSwap = vargArr(i)
        vargArr(i) = vargArr(j)
        vargArr(j) = vSwap
        i = i + 1
        j = j - 1
    Loop
    
    If (lngMin < i - 1) Then
        Call getArrSortQuick(vargArr, lngMin, i - 1)
    End If
        
    If (lngMax > j + 1) Then
        Call getArrSortQuick(vargArr, j + 1, lngMax)
    End If

    getArrSortQuick = vargArr
    
End Function

重複削除

'*****************************************************************
'* 重複削除
'*
'* ARG 01 : 対象配列
'* ARG 02 : LBound(対象配列)
'* ARG 03 : UBound(対象配列)
'* 戻り値 : 配列
'*
'* 説明   : Dictionaryで配列要素をKey、Valを追加
'*           Key重複できないのでErrで追加不可
'*           Key(Val)値は、重複削除の値となる
'*
'*****************************************************************
Public Function getArrDelSameVal( _
                                vArrSrc() As Variant _
                                ) As Variant()
     
    Dim dic
    Dim i As Long
    
    Set dic = CreateObject("Scripting.Dictionary")

On Error Resume Next
    For i = 0 To UBound(vArrSrc)
        dic.Add vArrSrc(i), vArrSrc(i)
    Next
    
    getArrDelSameVal = dic.Keys
    
    Set dic = Nothing

End Function

配列判定

'*****************************************************************
'* 配列判定
'*  引数が配列かどうか判断し、配列の場合は空かどうか判断する
'*
'* ARG 01 : 対象配列
'* 戻り値 : 1:配列 / 0:空の配列 / -1:配列でない
'*
'*****************************************************************
Public Function getArrIsExists( _
                              vArr As Variant _
                              ) As Long

On Error GoTo ERR_PROC
    
    If IsArray(vArr) Then   '// 配列確認
        getArrIsExists = IIf(UBound(vArr) >= 0, 1, 0)
        ' 配列が空の場合、Ubound Err=9(インデックスが有効範囲にありません)
    Else
        getArrIsExists = -1  '配列でない
    End If
    
    Exit Function
        
ERR_PROC:
    If Err.Number = 9 Then  '// UBound(vArr)
        getArrIsExists = 0   '// vArr = Empty
    End If
    
End Function

配列の次元数

'*****************************************************************
'* 配列の次元数
'*
'* ARG 01 : 対象配列
'* 戻り値 :
'*
'*****************************************************************
Public Function getArrDimension( _
                                arr As Variant _
                                ) As Long
    
    Dim tmp As Variant
    Dim i As Long
     
    '■エラーが出るまでループ処理
    On Error Resume Next
    Do While Err.Number = 0
        i = i + 1
        tmp = UBound(arr, i)
    Loop
    On Error GoTo 0
     
    '■エラーが出た前の数(i-1)が渡された配列の次元数
    getArrDimension = i - 1
    
End Function

二次元配列 → 一次元配列

'*****************************************************************
'* 二次元配列 → 一次元配列
'*  2次元配列から一次元配列に移行する
'*
'* ARG 01 : 対象2次配列
'* 戻り値 :
'*
'*****************************************************************
Public Function getArrConvArray2dTo1d( _
                                      Array2D _
                                      ) As Variant()
    
    Dim v
    Dim i As Long
    Dim r As Long, c As Long
    
    Dim Array1D() As Variant '一次元配列
    For r = LBound(Array2D, 1) To UBound(Array2D, 1)
      For c = LBound(Array2D, 2) To UBound(Array2D, 2)
        ReDim Preserve Array1D(i)
        Array1D(i) = Array2D(r, c)
        i = i + 1
      Next c
    Next r

    getArrConvArray2dTo1d = IIf(IsArray(Array1D), Array1D, Array(Array1D))
    
End Function

二次元配列 → 指定行or列 の 一次元配列

'*****************************************************************
'* 二次元配列 → 指定行or列 の 一次元配列
'*  二次元配列から特定行or列を一次元配列に移行する
'*
'* ARG 01 : 対象2次元配列
'* ARG 02 : 行or列 [ROW]or[COL]
'* ARG 03 : 指定行or列番号
'* 戻り値 :
'*
'*****************************************************************
Public Function getArrConv2dTo1dAtIndexNo( _
                                      Array2D, _
                                      ByVal sRowOrCol As String, _
                                      ByVal iSelRowOrColNo As Long _
                                      ) As Variant()
    Dim i As Long
    Dim Array1D As Variant '一次元配列
'    Dim Array2D As Variant '二次元配列
 
'    Array2D = Range("A1:B1")
'    Array2D = rngTrg
 
    Select Case sRowOrCol
    Case "ROW"
        Select Case getArrDimension(Array2D)
        Case 2
            '■二次元配列の指定行(2行目)を一次元配列に格納する
            Array1D = WorksheetFunction.Index(Array2D, iSelRowOrColNo)
        Case 1
            Array1D = Array2D
        Case Else
            Stop
        End Select
    
    Case "COL"
       '■二次元配列の指定列(A列(1列目))を一次元配列に格納する
       '(行列反転して対象行を取得)※縦一列だとうまくいかない。
        Select Case getArrDimension(Array2D)
        Case 2, 1
            Array1D = WorksheetFunction.Index(WorksheetFunction.Transpose(Array2D), iSelRowOrColNo)
        Case Else
            Stop
        End Select
    
    Case Else
        Stop
    
    End Select
    
    getArrConv2dTo1dAtIndexNo = IIf(IsArray(Array1D), Array1D, Array(Array1D))
    
End Function

多次元配列 → 一次元配列

'*****************************************************************
'* 多次元配列 → 一次元配列
'*  多次元配列から一次元配列に移行する
'*
'* ARG 01 : 対象配列
'* 戻り値 :
'*
'*****************************************************************
Public Function getArrConvMultiDimToSingleDim( _
                                      arr _
                                      ) As Variant()
    
    Dim v
    Dim i As Long
    
    Dim Array1D() As Variant '一次元配列
    For Each v In arr
      ReDim Preserve Array1D(i)
      Array1D(i) = v
      i = i + 1
      
    Next v

    getArrConvArray2dTo1d = IIf(IsArray(Array1D), Array1D, Array(Array1D))
    
End Function

配列の最大値

'*****************************************************************
'* 配列の最大値
'*
'* ARG 01 : 対象配列(1次元,2次元,配列の配列) ※ジャグ配列はNG
'* 戻り値 :
'*
'*****************************************************************
Public Function getArrMax( _
                        vArr As Variant _
                        )
                        
  getArrMax = WorksheetFunction.Max(vArr)
  
End Function

一次元配列 → セル

'*****************************************************************
'* 一次元配列 → セル
'*  配列1D(one dimension)をセルに出力
'*
'* ARG01 : 対象データ
'* ARG02 : 出力開始セル
'* ARG03 : 出力方向 [H]Horizon, [V]Vertical
'*
'* 戻り値
'*
'*****************************************************************
Public Sub setArr1dToRng( _
                                vArr() As Variant, _
                                ByVal rngStartCell As Range, _
                                ByVal direction As String _
                                )

    '=======================
    '//
    '=======================
    Dim lRowMax As Long:
    Dim lColMax As Long:
    
    Select Case direction
    Case "H"
        lRowMax = 1
        lColMax = UBound(vArr, 1) - LBound(vArr, 1) + 1
        
        '※出力サイズの設定が必要
        rngStartCell.Resize(lRowMax, lColMax).Value = vArr
    
    Case "V"
        lRowMax = UBound(vArr, 1) - LBound(vArr, 1) + 1
        lColMax = 1
        
        '※出力サイズの設定が必要
        rngStartCell.Resize(lRowMax, lColMax).Value = WorksheetFunction.Transpose(vArr)
    
    End Select
    
End Sub

二次元配列 → セル

'*****************************************************************
'* 二次元配列 → セル
'*  配列2D(two dimension)をセルに出力
'*
'* ARG01 : 対象データ
'* ARG02 : 出力開始セル
'*
'* 戻り値
'*
'*****************************************************************
Public Sub setArr2dToRng( _
                                vArr As Variant, _
                                rngStartCell As Range _
                                )

    '=======================
    '//
    '=======================
    Dim lRowMax As Long:    lRowMax = UBound(vArr, 1) - LBound(vArr, 1) + 1
    Dim lColMax As Long:    lColMax = UBound(vArr, 2) - LBound(vArr, 2) + 1
    
    '※出力サイズの設定が必要
    rngStartCell.Resize(lRowMax, lColMax).Value = vArr
    
End Sub

セル範囲 → 二次元配列

'*****************************************************************
'* セル範囲 → 二次元配列
'*  セル範囲の値を2次元配列で取得
'*
'* ARG01 : 対象データ
'* ARG02 : 出力開始セル
'*
'* 戻り値 :
'*
'*****************************************************************
Public Function getRngToArr2d( _
                                  ByVal rng As Range _
                                  ) As Variant()

    '=======================
    '// セルの値を要素に代入
    '=======================
    Dim vArrCell As Variant
    vArrCell = rng.Value    '※indexは「1」から
    
    getRngToArr2d = vArrCell
    
End Function

セル行範囲、指定列 → 配列の配列

'*****************************************************************
'* セル行範囲、指定列 → 配列の配列
'*  指定行範囲、指定列番号リストのセル値を配列の配列で返す
'*
'* ARG 01 : WorkSheet
'* ARG 02 : 行範囲配列(開始:終了)
'* ARG 03 : 対象列番号
'*
'* 戻り値 : 配列の配列
'*
'*****************************************************************
Public Function getRngRowsAndColListsToArrOfArr( _
                                            ws As Worksheet, _
                                            lRowStartEnd() As Long, _
                                            lColNos() As Long _
                                            ) As Variant
  Dim vResDat() As Variant
  
  Dim lRow As Long
  
  Dim i As Long: i = 0
  For lRow = lRowStartEnd(LBound(lRowStartEnd)) To lRowStartEnd(UBound(lRowStartEnd))
    ReDim Preserve vResDat(i)
    
    '// 列データ
    Dim sBuf()
    ReDim sBuf(UBound(lColNos))
            
    Dim j As Long: j = 0
    Dim vCol As Variant
    For Each vCol In lColNos
        sBuf(j) = ws.Cells(lRow, vCol).Value
        j = j + 1
    Next
    
    vResDat(i) = sBuf
    i = i + 1
  Next
  
  getRngRowsAndColListsToArrOfArr = vResDat
        
End Function

二次元文字列配列 → 半角・大文字

'*****************************************************************
'* 二次元文字列配列 → 半角・大文字
'*
'* ARG 01 : 対象配列
'* 戻り値 :
'*
'*****************************************************************
Public Function getArr2dConvNarrowUpper( _
                                      arr2D _
                                      ) As Variant
              
  Dim resArr2D
  ReDim resArr2D(LBound(arr2D, 1) To UBound(arr2D, 1), LBound(arr2D, 2) To UBound(arr2D, 2))
  
  Dim r, c
  
  Dim sBuf As String
  
  For r = LBound(arr2D, 1) To UBound(arr2D, 1)
    For c = LBound(arr2D, 2) To UBound(arr2D, 2)
      sBuf = StrConv(arr2D(r, c), vbNarrow)
      sBuf = StrConv(sBuf, vbUpperCase)
      resArr2D(r, c) = sBuf
    Next c
  Next r
  
  getArr2dConvNarrowUpper = resArr2D
  
End Function


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

ExcelVBA:TOP3

文字列操作

VBA:Excel:文字列操作 - プログラミングのメモ

配列とセル

VBA:Excel:配列とセル

辞書

VBA:Excel :辞書 - プログラミングのメモ

コレクション

VBA:Excel:コレクション - プログラミングのメモ