aTEST_Array
Sub aTEST_Array()
Dim arr()
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")
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
Dim vNotArr
lRes = getArrIsExists(vNotArr)
Dim vArr()
lRes = getArrIsExists(vArr)
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
Sub aTEST2_Array()
Dim Array1D 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
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")
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
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次元配列
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)
If UBound(vArrayOfArray(r)) <> iColNum Then
getArrayOfArrayToArr = Array()
Exit Function
End If
For c = LBound(vArrayOfArray(r)) To UBound(vArrayOfArray(r))
vRes_2dArr(r, c) = vArrayOfArray(r)(c)
Next
Next
getArrayOfArrayToArr = vRes_2dArr
End Function
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
重複削除
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
配列判定
Public Function getArrIsExists( _
vArr As Variant _
) As Long
On Error GoTo ERR_PROC
If IsArray(vArr) Then
getArrIsExists = IIf(UBound(vArr) >= 0, 1, 0)
Else
getArrIsExists = -1
End If
Exit Function
ERR_PROC:
If Err.Number = 9 Then
getArrIsExists = 0
End If
End Function
配列の次元数
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
getArrDimension = i - 1
End Function
二次元配列 → 一次元配列
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列 の 一次元配列
Public Function getArrConv2dTo1dAtIndexNo( _
Array2D, _
ByVal sRowOrCol As String, _
ByVal iSelRowOrColNo As Long _
) As Variant()
Dim i As Long
Dim Array1D As Variant
Select Case sRowOrCol
Case "ROW"
Select Case getArrDimension(Array2D)
Case 2
Array1D = WorksheetFunction.Index(Array2D, iSelRowOrColNo)
Case 1
Array1D = Array2D
Case Else
Stop
End Select
Case "COL"
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
多次元配列 → 一次元配列
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
配列の最大値
Public Function getArrMax( _
vArr As Variant _
)
getArrMax = WorksheetFunction.Max(vArr)
End Function
一次元配列 → セル
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
二次元配列 → セル
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
セル範囲 → 二次元配列
Public Function getRngToArr2d( _
ByVal rng As Range _
) As Variant()
Dim vArrCell As Variant
vArrCell = rng.Value
getRngToArr2d = vArrCell
End Function
セル行範囲、指定列 → 配列の配列
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
二次元文字列配列 → 半角・大文字
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