怎样得到数组的维数?急!!!!!!!!!!!!

Question

怎样得到数组的维数?

Answer 1

''UBound属性获得数组的上标
Dim intBound As Integer
Dim strBuf(9) as StringintBoud=UBound(strBuf)''结果intBoud=9''LBound属性获得数组的下标
intBound=LBound(strBuf)

Answer 2

错:我是想得到数组的维数
例:var(2,1)就是2维,var(2,1,3)就是3维高手帮忙阿

Answer 3

有一个变通的方法是通过错误捕获如下：
    On Error Goto BoundsError
    For I = 1 To 1000     '不会有这么多维数的数组 
        lTemp = LBound(MyArr, I)
    Next
BoundErro:
    nDims = I - 1
    MsgBox "这个数组有" & nDims & "维"
如果你知道SafeArray的原理，也可以直接得到维数，如下：
    '先得到一个指向SafeArray结构的指针的指针
    ppMyArr = VarPtrArray(MyArr)
    '从这个指针的指针得到SafeArray结构的指针
    CopyMemory pMyArr, ByVal ppMyArr, 4
    '再从这个指针所指地址的头两个字节取出cDims 
    CopyMemory nDims, ByVal pMyArr, 2
    MsgBox "这个数组有" & nDims & "维"

Answer 4

完整的示例代码如下：
（注意所有的变量必需要声明）
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Var() As Any) As Long
Dim MyArr(3, 4, 5, 6)
Dim nDims As LongPrivate Sub Form_Load()
On Error GoTo BoundsError
    For I = 1 To 1000     
        lTemp = LBound(MyArr, I)
    Next
BoundsError:
    nDims = I - 1
    MsgBox "这个数组有" & nDims & "维"
End SubPrivate Sub Form_Click()
    Dim ppMyArr As Long, pMyArr As Long
    ppMyArr = VarPtrArray(MyArr)    CopyMemory pMyArr, ByVal ppMyArr, 4    CopyMemory nDims, ByVal pMyArr, 2    MsgBox "这个数组有" & nDims & "维"
End Sub

Answer 5

Option Explicit
Private Type RECT
        Left As Long
        Top As Long
        Width As Long
        Height As Long
End Type
Private crlMsg() As RECT
Private sngWidth As Single
Private sngHeight As Single
Private sngScaleX As Single
Private sngScaleY As Single
Private intNum As IntegerPrivate Sub Form_Load()
    '打开错误处理陷阱
   On Error GoTo ErrGoto
   '----------------------------------------------------
   '代码正文
  
    Dim i As Integer
     intNum = Me.Controls.Count
     ReDim Preserve crlMsg(intNum - 1) As RECT
     
     For i = 0 To intNum - 1
        crlMsg(i).Left = Me.Controls(i).Left
        crlMsg(i).Top = Me.Controls(i).Top
        crlMsg(i).Width = Me.Controls(i).Width
        crlMsg(i).Height = Me.Controls(i).Height
     Next
     
     sngWidth = Me.Width
     sngHeight = Me.Height
     
     sngScaleX = 1
     sngScaleY = 1
   '----------------------------------------------------
   Exit Sub
   '-----------------------------
ErrGoto:
  Resume NextEnd SubPrivate Sub Form_Resize()
   '打开错误处理陷阱
   On Error GoTo ErrGoto
   '----------------------------------------------------
   '代码正文
  Static oldX As Single
  Static oldY As Single
  Dim i As Integer
  
  sngScaleX = Me.Width * 1# / sngWidth
  sngScaleY = Me.Height * 1# / sngHeight
  
  If Abs(sngScaleX - oldX) > 0.01 Or Abs(sngScaleY - oldY) > 0.01 Then
    For i = 0 To intNum - 1
        Me.Controls(i).Left = crlMsg(i).Left * sngScaleX
        Me.Controls(i).Top = crlMsg(i).Top * sngScaleY
        Me.Controls(i).Width = crlMsg(i).Width * sngScaleX
        Me.Controls(i).Height = crlMsg(i).Height * sngScaleY
     Next
  End If
  
  oldX = sngScaleX
  oldY = sngScaleY
  
  '----------------------------------------------------
   Exit Sub
   '-----------------------------
ErrGoto:
  Resume NextEnd Sub
'控件已发

Answer 6

麻烦楼主结贴时提交一下　FAQ

Answer 7

wxy_xiaoyu☆然也☆ 的代码有一点还没有考虑到Private Sub Form_Click()    Dim ppMyArr As Long, pMyArr As Long
    
    ppMyArr = VarPtrArray(MyArr)
    CopyMemory pMyArr, ByVal ppMyArr, 4
    CopyMemory nDims, ByVal pMyArr, 2
    MsgBox "这个数组有" & nDims & "维"
    
    Dim EmptyArray1() As Long
    ReDim EmptyArray1(1, 2, 3, 4, 5)
    ppMyArr = VarPtrArray(EmptyArray1)
    CopyMemory pMyArr, ByVal ppMyArr, 4
    CopyMemory nDims, ByVal pMyArr, 2
    MsgBox "这个数组有" & nDims & "维"
    
    Dim EmptyArray2() As Long
    ppMyArr = VarPtrArray(EmptyArray2) 'ppMyArr = 0
    CopyMemory pMyArr, ByVal ppMyArr, 4
    CopyMemory nDims, ByVal pMyArr, 2 '这句出现内存访问错误
    MsgBox "这个数组有" & nDims & "维"
   
End Sub

Answer 8

Public Function weishu(sz() As String) As Integer
Dim i As Integer
Dim count As IntegerOn Error GoTo BoundError
    For i = 1 To 61     '不会有这么多维数的数组
        count = LBound(sz(), i)
    Next
BoundError:
    weishu = i - 1End Function