我有一个表格(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)是否存在 - 如果不存在,那么它应该是另外两种情况之一。仍然围绕同样的基本问题展开。
答案 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