Skip to content

Instantly share code, notes, and snippets.

@furyutei

furyutei/0.README.md

Last active August 28, 2024 04:37
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save furyutei/01d0cfa88dac58f73a5bda1147f76676 to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save furyutei/01d0cfa88dac58f73a5bda1147f76676 to your computer and use it in GitHub Desktop.
Download ZIP
[VBA] 配列の次元数を取得する関数
Raw
0.README.md

[VBA] 配列の次元数を取得する関数

ソースコード

※共に、引数に配列以外を指定した場合は-1、初期化されていない(要素数未指定の)動的配列を指定した場合は0を返す

ひとりごと

個人的に、VBAの配列は使い勝手が悪すぎるので、できれば使いたくない……お手軽に使える代替手段が欲しい……。

といったものを使ったとしても、基本的には1次元配列だし、Array→Object変換が鬼門……。

Raw
Mod_ArrayDim.vba
Option Explicit
Private Declare PtrSafe Sub RtlMoveMemory Lib "Kernel32" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As LongPtr)
Function GetArrayDim(Target As Variant) As Long
Const RET_NOT_ARRAY As Long = -1
Const RET_NOT_INITIALIZED As Long = 0
Const VT_ARRAY As Integer = &H2000
Const VT_BYREF As Integer = &H4000
Const PARRAY_OFFSET As Long = 8 ' vt(VARTYPE:2 bytes)+(WORD:2 bytes)×3
Dim vt As Integer
Dim pArray As LongPtr
Dim cDim As Integer
Call RtlMoveMemory(vt, Target, Len(vt))
If (vt And VT_ARRAY) = &H0 Then
GetArrayDim = RET_NOT_ARRAY
Exit Function
End If
Call RtlMoveMemory(pArray, ByVal (VarPtr(Target) + PARRAY_OFFSET), Len(pArray))
If (vt And VT_BYREF) = VT_BYREF Then
Call RtlMoveMemory(pArray, ByVal pArray, Len(pArray))
End If
If pArray = 0 Then
GetArrayDim = RET_NOT_INITIALIZED
Exit Function
End If
Call RtlMoveMemory(cDim, ByVal pArray, Len(cDim))
GetArrayDim = CLng(cDim)
End Function
Sub TestDim1()
Dim TestArray
TestArray = Range("A1"): Debug.Print "A1", GetArrayDim(TestArray)
TestArray = Range("A1:B1"): Debug.Print "A1:B1", GetArrayDim(TestArray)
TestArray = Range("A1:A2"): Debug.Print "A1:A2", GetArrayDim(TestArray)
TestArray = Range("A1:B2"): Debug.Print "A1:B2", GetArrayDim(TestArray)
Debug.Print "Index(A1:B2,1,1)", GetArrayDim(WorksheetFunction.Index(TestArray, 1, 1))
Debug.Print "Index(A1:B2,1,0)", GetArrayDim(WorksheetFunction.Index(TestArray, 1, 0))
Debug.Print "Index(A1:B2,0,1)", GetArrayDim(WorksheetFunction.Index(TestArray, 0, 1))
End Sub
Sub TestDim2()
Dim Arr() As String: Debug.Print GetArrayDim(Arr)
ReDim Arr(3, 4): Debug.Print GetArrayDim(Arr)
Arr(0, 0) = 999: Debug.Print GetArrayDim(Arr)
Erase Arr: Debug.Print GetArrayDim(Arr)
End Sub
Raw
Mod_ArrayDimension.vba
Option Explicit
Function GetArrayDimension(Target As Variant) As Long
Dim Dimension As Long
If Not IsArray(Target) Then GoTo CLEANUP
Dim WorkBound As Long
On Error GoTo CLEANUP
Do
Dimension = Dimension + 1
WorkBound = UBound(Target, Dimension)
Loop
CLEANUP:
GetArrayDimension = Dimension - 1
End Function
Sub TestDimension1()
Dim TestArray
TestArray = Range("A1"): Debug.Print "A1", GetArrayDimension(TestArray)
TestArray = Range("A1:B1"): Debug.Print "A1:B1", GetArrayDimension(TestArray)
TestArray = Range("A1:A2"): Debug.Print "A1:A2", GetArrayDimension(TestArray)
TestArray = Range("A1:B2"): Debug.Print "A1:B2", GetArrayDimension(TestArray)
Debug.Print "Index(A1:B2,1,1)", GetArrayDimension(WorksheetFunction.Index(TestArray, 1, 1))
Debug.Print "Index(A1:B2,1,0)", GetArrayDimension(WorksheetFunction.Index(TestArray, 1, 0))
Debug.Print "Index(A1:B2,0,1)", GetArrayDimension(WorksheetFunction.Index(TestArray, 0, 1))
End Sub
Sub TestDimension2()
Dim Arr() As String: Debug.Print GetArrayDimension(Arr)
ReDim Arr(3, 4): Debug.Print GetArrayDimension(Arr)
Arr(0, 0) = 999: Debug.Print GetArrayDimension(Arr)
Erase Arr: Debug.Print GetArrayDimension(Arr)
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment