Alan Beban said:
Harlan Grove wrote: ....
And another. I don't dismiss it; I just think users can decide for
themselves how much weight to give it in their particular
applications.
Users can decide for themselves.
Remember my ct function from a few months ago? I've revised it a bit.
Function ct( _
ByRef a As Variant, _
ByRef b As Variant, _
Optional c As Boolean = False _
) As Boolean
'------------------------------------------------------------------
'c argument controls whether proc continues to initialize b from a
'when any conversion errors occur: True = continue, False = return
'immediately -- return value True means conversion error(s) occurred,
'False means success
'-------------------------------------------------------------------
Dim i As Long, n As Long
Dim i1 As Long, i2 As Long, i3 As Long
Dim i4 As Long, i5 As Long, i6 As Long
Dim u1 As Long, u2 As Long, u3 As Long
Dim u4 As Long, u5 As Long, u6 As Long
'truncate range initializers
If TypeOf a Is Range Then a = a.Areas(1).Value
If Not (IsArray(a) Or IsArray(b)) Then 'both scalars -- FIXED!
'leave type conversion to VBA, let b obj but a not throw an error,
'let a obj but b not rely upon default obj to scalar conversion
On Error Resume Next
If IsObject(b) Then Set b = a Else b = a
ct = (Err.Number <> 0)
On Error GoTo 0
ElseIf IsArray(a) And IsArray(b) Then
'check that b is empty - necessary precondition
On Error Resume Next
u1 = UBound(b, 1)
If Err.Number = 0 Then Exit Function Else Err.Clear
'count number of dimensions of a while storing dim'n bounds
On Error GoTo EndCountDimensions
i1 = LBound(a, 1)
u1 = UBound(a, 1)
n = 1
i2 = LBound(a, 2)
u2 = UBound(a, 2)
n = 2
i3 = LBound(a, 3)
u3 = UBound(a, 3)
n = 3
i4 = LBound(a, 4)
u4 = UBound(a, 4)
n = 4
i5 = LBound(a, 5)
u5 = UBound(a, 5)
n = 5
i6 = LBound(a, 6)
u6 = UBound(a, 6)
n = 6
EndCountDimensions:
Err.Clear
On Error GoTo 0
Select Case n
Case 1:
ReDim b(i1 To u1)
For i1 = i1 To u1
If ct(a(i1), b(i1)) Then
ct = True
If Not c Then Exit Function
End If
Next i1
Case 2:
ReDim b(i1 To u1, i2 To u2)
For i1 = i1 To u1
For i2 = i2 To u2
If ct(a(i1, i2), b(i1, i2)) Then
ct = True
If Not c Then Exit Function
End If
Next i2
Next i1
Case 3:
ReDim b(i1 To u1, i2 To u2, i3 To u3)
For i1 = i1 To u1
For i2 = i2 To u2
For i3 = i3 To u3
If ct(a(i1, i2, i3), b(i1, i2, i3)) Then
ct = True
If Not c Then Exit Function
End If
Next i3
Next i2
Next i1
Case 4:
ReDim b(i1 To u1, i2 To u2, i3 To u3, i4 To u4)
For i1 = i1 To u1
For i2 = i2 To u2
For i3 = i3 To u3
For i4 = i4 To u4
If ct(a(i1, i2, i3, i4), _
b(i1, i2, i3, i4)) Then
ct = True
If Not c Then Exit Function
End If
Next i4
Next i3
Next i2
Next i1
Case 5:
ReDim b(i1 To u1, i2 To u2, i3 To u3, i4 To u4, _
i5 To u5)
For i1 = i1 To u1
For i2 = i2 To u2
For i3 = i3 To u3
For i4 = i4 To u4
For i5 = i5 To u5
If ct(a(i1, i2, i3, i4, i5), _
b(i1, i2, i3, i4, i5)) Then
ct = True
If Not c Then Exit Function
End If
Next i5
Next i4
Next i3
Next i2
Next i1
Case 6:
ReDim b(i1 To u1, i2 To u2, i3 To u3, i4 To u4, _
i5 To u5, i6 To u6)
For i1 = i1 To u1
For i2 = i2 To u2
For i3 = i3 To u3
For i4 = i4 To u4
For i5 = i5 To u5
For i6 = i6 To u6
If ct(a(i1, i2, i3, i4, i5, i6), _
b(i1, i2, i3, i4, i5, i6)) Then
ct = True
If Not c Then Exit Function
End If
Next i6
Next i5
Next i4
Next i3
Next i2
Next i1
Case Else 'unsupported number of dim'ns
ct = True
Exit Function
End Select
Else 'unsupported mixed references
ct = True
End If
End Function
I put it into your ArrayFunctions library along with the following testing
macro.
Sub testemhard()
Const MAXITER As Long = 2000000
Dim arr1() As String, arr2() As Variant, arr3 As Variant
Dim k As Long
Dim t As Long
t = Timer
For k = 1 To MAXITER
ReDim arr1(1 To 4)
arr1(1) = "ab"
arr1(2) = "cd"
arr1(3) = "ef"
arr1(4) = "gh"
ReDim Preserve arr1(1 To 5)
arr1(5) = "ij"
Next k
Debug.Print "test1: " & Format$(Timer - t, "##0.00");
For k = LBound(arr1) To UBound(arr1)
Debug.Print " "; arr1(k);
Next k
Debug.Print ""
t = Timer
For k = 1 To MAXITER
ReDim arr2(1 To 4)
arr2(1) = "ab"
arr2(2) = "cd"
arr2(3) = "ef"
arr2(4) = "gh"
ReDim Preserve arr2(1 To 5)
arr2(5) = "ij"
Next k
Debug.Print "test2: " & Format$(Timer - t, "##0.00");
For k = LBound(arr1) To UBound(arr1)
Debug.Print " "; arr1(k);
Next k
Debug.Print ""
t = Timer
For k = 1 To MAXITER
ReDim arr3(1 To 4)
arr3(1) = "ab"
arr3(2) = "cd"
arr3(3) = "ef"
arr3(4) = "gh"
ReDim Preserve arr3(1 To 5)
arr3(5) = "ij"
Next k
Debug.Print "test3: " & Format$(Timer - t, "##0.00");
For k = LBound(arr1) To UBound(arr1)
Debug.Print " "; arr1(k);
Next k
Debug.Print ""
Erase arr3
t = Timer
For k = 1 To MAXITER
arr3 = Array("ab", "cd", "ef", "gh")
ReDim Preserve arr3(4)
arr3(4) = "ij"
Next k
Debug.Print "test4: " & Format$(Timer - t, "##0.00");
For k = LBound(arr1) To UBound(arr1)
Debug.Print " "; arr1(k);
Next k
Debug.Print ""
Erase arr1
t = Timer
For k = 1 To MAXITER
ct Array("ab", "cd", "ef", "gh"), arr1
ReDim Preserve arr1(4)
arr1(4) = "ij"
Next k
Debug.Print "test5: " & Format$(Timer - t, "##0.00");
For k = LBound(arr1) To UBound(arr1)
Debug.Print " "; arr1(k);
Next k
Debug.Print ""
Erase arr1
t = Timer
For k = 1 To (MAXITER / 10) '** iterating 10% as many times! **
Assign Array("ab", "cd", "ef", "gh"), arr1
ReDim Preserve arr1(4)
arr1(4) = "ij"
Next k
Debug.Print "test6: " & Format$(Timer - t, "##0.00");
For k = LBound(arr1) To UBound(arr1)
Debug.Print " "; arr1(k);
Next k
Debug.Print ""
End Sub
and this testing macro gave the following results.
test1: 10.98 ab cd ef gh ij
test2: 11.68 ab cd ef gh ij
test3: 15.44 ab cd ef gh ij
test4: 28.56 ab cd ef gh ij
test5: 28.18 ab cd ef gh ij
test6: 34.78 ab cd ef gh ij
which means that ct appears to run more than 11 times faster than Assign,
and ct appears comparable to assigning arrays to scalar variants
(surprising!). Explicit item-by-item initialization to arrays of specific
type is still fastest, though. But you can ponder whether Assign should be
as slow as it appears to be.