新建From1(窗体),新建Command1(按钮CommandButton),代码:
'Purpose : Removes an item from a 1d array.
'Inputs : avRemoveFrom The array to remove the item from.
' [lIndex] The index of the item to remove.
' [vItemToRemove] The value of the item to remove.
' [bPreserveOrder] If True the order of the array is preserved (slightly slower)
'Outputs : Returns True if removed item from array.
'Notes : Specify EITHER the lIndex OR vItemToRemove.
' If vItemToRemove is specified and the array contains more than one item with this value,
' the first item in which matches this value will be removed. Will NOT work with fixed
' arrays (eg. Dim myArray(1 to 5) as String). Arrays must be declared as dynamic (eg.
' Dim myArray() as String).
Private Function Array1DRemove(ByRef avRemoveFrom As Variant, Optional lIndex As Long, Optional vItemToRemove As Variant, Optional bPreserveOrder As Boolean = False) As Boolean
Dim lUbound As Long, vTempVal As Variant, lLBound As Long, bFoundItem As Boolean
Dim lThisItem As Long
On Error GoTo ErrFailed
lUbound = UBound(avRemoveFrom)
lLBound = LBound(avRemoveFrom)
If IsMissing(vItemToRemove) Then
If lUbound >= lIndex Then
'Found item
bFoundItem = True
End If
Else
'Remove item by value, find the item in the array
For lIndex = lLBound To lUbound
If avRemoveFrom(lIndex) = vItemToRemove Then
'Found item
bFoundItem = True
Exit For
End If
Next
End If
If bFoundItem Then
'Found item
If bPreserveOrder Then
'Preserve the order of the array,
'by copying the values up the order fo the array
For lThisItem = lIndex To lUbound - 1
avRemoveFrom(lThisItem) = avRemoveFrom(lThisItem + 1)
Next
Else
'Copy last item into a temp variable
vTempVal = avRemoveFrom(lUbound)
'Overwrite item to delete
avRemoveFrom(lIndex) = vTempVal
End If
'Resize the array
ReDim Preserve avRemoveFrom(lLBound To lUbound - 1)
Array1DRemove = True
End If
Exit Function
ErrFailed:
Debug.Print Err.Description
Array1DRemove = False
On Error GoTo 0
End Function
Private Sub Command1_Click()
Dim alValues() As Long, lThisItem As Long
ReDim alValues(1 To 5)
For lThisItem = 1 To 5
alValues(lThisItem) = lThisItem * 2
Next
'Remove item with a value 4 (preserving the order of the array)
Array1DRemove alValues, , 4, True
'Remove item 1 (preserving the order of the array)
Array1DRemove alValues, 1, True
End Sub