ファイル/フォルダ
TEST
VSCode:Emmet
参考
VS Code でEmmet使ったらHTML書くの速くなった~‼ - Qiita
VS Codeの日本語化とEmmetの設定について|ドットインストール|note
設定
lang="ja"
『歯車』 → 『設定』 → 検索「emmet」→『Emmet: Valiables』[項目の追加] 項目:lang、値:jp
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
- aTEST2_Array
- aTEST_CellArray
- aTest2
- 配列の配列 → 2次元配列
- クイックソート
- 重複削除
- 配列判定
- 配列の次元数
- 二次元配列 → 一次元配列
- 二次元配列 → 指定行or列 の 一次元配列
- 多次元配列 → 一次元配列
- 配列の最大値
- 一次元配列 → セル
- 二次元配列 → セル
- セル範囲 → 二次元配列
- セル行範囲、指定列 → 配列の配列
- 二次元文字列配列 → 半角・大文字
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
- 文字列を指定文字数で分割して配列で返す
- 文字列をASCII変換して配列で返す
- 文字列をUnicode(UTF-16)変換して配列で返す
- ASCII配列を文字列変換して配列で返す
- Unicode(UTF-16)配列を文字列変換して配列で返す
- 文字列を検索して、前or後を返す
- 指定文字の個数を返す
- 指定文字を繰り返す
- パターンマッチング:LIKE
- パターンマッチング:正規表現
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