|
Visual Basic (VB and VBA) |
|
Copyright 1999-2001 Christopher Greaves. All rights reserved. Home Page and email to [email protected] |
| If in doubt, record a macro and inspect the entrails! |
Please read the DISCLAIMER.
Here is an INDEX to all the procedures.
You will probably need one copy of my GLOBAL DECLARATIONS.
Public Function ReduceSet(lngItems() As Long, lngResult() As Long)
' Procedure : ReduceSet
' Description: Remove items of LngResult from lngItems.
' Copyright: Chris Greaves Inc.
' Inputs: A Source array (2,x) of LONG, a Data array (2,x) of long
' Returns:
' Assumes: Nothing
' Side Effects: The source array will be modified.
' Tested: By the calls shown below.
Dim intI As Integer
Dim intJ As Integer
Dim intLimLngItems As Integer
intLimLngItems = UBound(lngItems, 2)
For intI = 0 To UBound(lngResult, 2) ' for each item to be removed
For intJ = 0 To intLimLngItems ' examine each item of the original list
If (lngItems(0, intJ) = lngResult(0, intI)) And (lngItems(1, intJ) = lngResult(1, intI)) Then ' we have found a match between the two arrays
While intJ < UBound(lngItems, 2) ' shuffle higher elements downwards, overwritng the current item
lngItems(0, intJ) = lngItems(0, intJ + 1)
lngItems(1, intJ) = lngItems(1, intJ + 1)
intJ = intJ + 1
Wend
intLimLngItems = intLimLngItems - 1
Exit For
Else
End If
Next intJ
Next intI
If intLimLngItems < 0 Then
ReDim lngItems(0, 0)
Else
ReDim Preserve lngItems(1, intLimLngItems)
End If
'Sub TESTReduceset()
'Dim lngItems() As Long
'ReDim lngItems(15)
'lngItems(0) = 777
'lngItems(1) = 574
'lngItems(2) = 293
'lngItems(3) = 232
'lngItems(4) = 126
'lngItems(5) = 126
'lngItems(6) = 126
'lngItems(7) = 121
'lngItems(8) = 101
'lngItems(9) = 92
'lngItems(10) = 92
'lngItems(11) = 91
'lngItems(12) = 87
'lngItems(13) = 78
'lngItems(14) = 76
'lngItems(15) = 71
'Dim lngResult() As Long
'ReDim lngResult(2)
'lngResult(0) = 777
'lngResult(1) = 232
'lngResult(2) = 126
'Call ReduceSet(lngItems, lngResult)
' ReDim Preserve lngItems(UBound(lngItems) - UBound(lngResult) - 1)
'End Sub
End Function
| We all knew nothing when we started … |
|
Home Page and Contact Information Send email to [email protected]. This page was last updated Thursday, November 15, 2001 |