Как проверить наличие пустых элементов в разных местах массива?Т.е. как я могу проверить, было ли место измерено в зубчатом массиве? - PullRequest
0 голосов
/ 05 октября 2011

У меня есть массив Cdo в ​​форме (j, 0) (i, 0).Есть два исключения: адреса (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 ]

1 голос
/ 06 октября 2011
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

Нечто подобное должно работать.Поиграйте с ним, чтобы сделать то, что вы хотите.

0 голосов
/ 06 октября 2011

Нахожу другое решение вопроса

    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
0 голосов
/ 06 октября 2011

, если вы хотите проверить, инициализирован массив или нет, вы должны использовать функцию 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

С уважением, Томас

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...