如何测试数组中不同位置的空元素?即如何测试位置是否已经在锯齿状数组中标注?

时间:2011-10-05 19:52:43

标签: vba

我有一个表格(j,0)(i,0)的数组Cdo。有两个例外:地址(j,0)或(j,0)(0),通常为空,可能包含一个带有错误消息的字符串[从不同时出现]。

想要传递这些错误而不会生成超出范围的下标,同时还要将其记录到已清理的数组,Breaks(二维,(j,i))。

For j = 0 to Symbol
    If TypeName(Cdo(j,0)) <> "String" Then
        If TypeName(Cdo(j,0)(0)) <> "String" Then
            For i = 0 to UBound(Cdo(j,0))
                Breaks(j,i) = Cdo(j,0)(i,0)
            Next i
        End if
        Breaks(j,1) = "#N/A"
    End if
    Breaks(j,1) = "#TrancheDef"
Next j

我尝试了IsEmpty并寻找一个字符串(显示),但是当他们看到没有尺寸的地方时他们都会抛出错误。我无法更改阵列 - 如何测试位置,例如(403)(0)(0)“存在”可以这么说吗?

或者: 我可以检查Cdo(j,0)(i,0)是否存在 - 如果不存在,那么它应该是另外两种情况之一。仍然围绕同样的基本问题展开。

3 个答案:

答案 0 :(得分:1)

function ItExists(byval j as integer) as boolean

  On Error Resume Next
  if lenb((j,0)(0)) then
  'Nothing
  end if
  ItExists=(err.number=0)
  On Error Goto 0

end function

像上面这样的东西应该有效。与它一起玩,使它做你想做的。

答案 1 :(得分:0)

如果要检查数组是否已初始化,则必须使用dll函数:

Option Explicit

Private Declare Function SafeArrayGetDim Lib "oleaut32.dll" (ByRef saArray() As Any) As Long

Private Sub Form_Load()
  Dim Cdo() As String
  'Cdo = Split("a,b,c", ",")

  If SafeArrayGetDim(Cdo) <> 0 Then
    MsgBox "Array has been Initialized"
  End If

End Sub

也许你也可以使用:

Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Ptr() As Any) As Long

关心托马斯

答案 2 :(得分:0)

我找到了问题的另一种解决方案

    Option Base 0
    Option Compare Binary
    Option Explicit

    Private Const VT_BYREF = &H4000
    Private Const VARIANT_DATA_OFFSET As Long = 8

    Private Declare Function SafeArrayGetDim Lib "oleaut32.dll" _
        (ByVal pSA As Long) _
        As Long

    Private Declare Function SafeArrayGetLBound Lib "oleaut32.dll" _
        (ByVal pSA As Long, _
         ByVal nDim As Long, _
         ByRef plLbound As Long) _
        As Long

    Private Declare Function SafeArrayGetUBound Lib "oleaut32.dll" _
        (ByVal pSA As Long, _
         ByVal nDim As Long, _
         ByRef plUbound As Long) _
        As Long

    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
        (ByRef lpDest As Any, _
         ByRef lpSource As Any, _
         ByVal lByteLen As Long)
    '


    Public Function LBoundEx(ByRef vArray As Variant, _
                             Optional ByVal lDimension As Long = 1) As Long

        Dim iDataType As Integer
        Dim pSA As Long

        'Make sure an array was passed in:
        If IsArray(vArray) Then

            'Try to get the pointer:
            CopyMemory pSA, ByVal VarPtr(vArray) + VARIANT_DATA_OFFSET, 4

            If pSA Then

                'If byref then deref the pointer to get the actual pointer:
                CopyMemory iDataType, vArray, 2
                If iDataType And VT_BYREF Then
                    CopyMemory pSA, ByVal pSA, 4
                End If

                If pSA Then
                    If lDimension > 0 Then
                        'Make sure this is a valid array dimension:
                        If lDimension <= SafeArrayGetDim(pSA) Then
                            'Get the LBound:
                            SafeArrayGetLBound pSA, lDimension, LBoundEx
                        Else
                            LBoundEx = -1
                        End If
                    Else
                        Err.Raise vbObjectError Or 10000, "LBoundEx", "Invalid Dimension"
                    End If
                Else
                    LBoundEx = -1
                End If
            Else
                LBoundEx = -1
            End If
        Else
            Err.Raise vbObjectError Or 10000, "LBoundEx", "Not an array"
        End If

    End Function


    Public Function UBoundEx(ByRef vArray As Variant, _
                             Optional ByVal lDimension As Long = 1) As Long

        Dim iDataType As Integer
        Dim pSA As Long

        'Make sure an array was passed in:
        If IsArray(vArray) Then

            'Try to get the pointer:
            CopyMemory pSA, ByVal VarPtr(vArray) + VARIANT_DATA_OFFSET, 4

            If pSA Then

                'If byref then deref the pointer to get the actual pointer:
                CopyMemory iDataType, vArray, 2
                If iDataType And VT_BYREF Then
                    CopyMemory pSA, ByVal pSA, 4
                End If

                If pSA Then
                    If lDimension > 0 Then
                        'Make sure this is a valid array dimension:
                        If lDimension <= SafeArrayGetDim(pSA) Then
                            'Get the UBound:
                            SafeArrayGetUBound pSA, lDimension, UBoundEx
                        Else
                            UBoundEx = -1
                        End If
                    Else
                        Err.Raise vbObjectError Or 10000, "UBoundEx", "Invalid Dimension"
                    End If
                Else
                    UBoundEx = -1
                End If
            Else
                UBoundEx = -1
            End If
        Else
            Err.Raise vbObjectError Or 10000, "UBoundEx", "Not an array"
        End If

    End Function



    Private Function test()
    Dim Cdo() As Variant
    Dim a() As String
    Dim b() As String

    ReDim Cdo(1 To 5, 1 To 2)
    ReDim a(1 To 2)
    ReDim b(1 To 3, 1 To 2)

    Cdo(1, 2) = a
    Cdo(2, 2) = b

    '- test
    Dim x As Long
    Dim y As Long
    Dim z As Long
    Dim q As Long
    Dim ok As Boolean

    x = 2
    y = 2
    z = 2
    q = 2 '- set to -1 for Cdo(x, y)(z) and to >=0 for Cdo(x, y)(z,q)

    ok = False

    If (UBoundEx(Cdo, 1) >= x) Then
      If (UBoundEx(Cdo, 2) >= y) Then
        If (Not IsEmpty(Cdo(x, y))) Then
          If (UBoundEx(Cdo(x, y), 1) >= z) Then
            If (q >= 0) Then
              If (UBoundEx(Cdo(x, y), 2) >= q) Then
                Debug.Print Cdo(x, y)(z, q)
                ok = True
              End If
            Else
              If (UBoundEx(Cdo(x, y), 2) = -1) Then
                Debug.Print Cdo(x, y)(z)
                ok = True
              End If
            End If
          End If
        End If
      End If
    End If

    if (ok) then
      debug.print "OK"
    end it
  End Function