terça-feira, 27 de julho de 2010

Funções para trabalhar com listas

Function RemoveFromList (Value As Variant, ValueList As Variant)
Dim tmpValueList() As String
x = 0
Redim Preserve tmpValueList(x)
Forall vals In ValueList
If Not Value = vals Then
Redim Preserve tmpValueList(x)
tmpValueList(x) = vals
x = x + 1
End If
End Forall
RemoveValueFromList = tmpValueList
End Function

Function AddToList (Value As Variant, ValueList As Variant)
Dim tmpValueList As Variant
' Load the array element by element so that the datatype is preserved
Redim tmpValueList(Ubound(ValueList))
For i = 0 To Ubound(ValueList)
tmpValueList(i) = ValueList(i)
Next
' Determine if we are dealing with a new list, if absolutely no
values in the first entry, then add new value to 0
If Ubound(tmpValueList) = 0 And Cstr(tmpValueList(0)) = "" Then
x = 0
Else
x = Ubound(tmpValueList) + 1
End If
Redim Preserve tmpValueList(x)
tmpValueList(x) = Value
AddToList = tmpValueList
End Function

Function RemoveItemFromList (intItem As Integer, ValueList As Variant)
' *** intItem should be passed in zero based as well as ValueList
Dim tmpValueList() As Variant
Dim intItemCnt As Integer
' Init the temporary list
Redim tmpValueList(0)
intItemCnt = 0
For x = 0 To Ubound(ValueList)
If Not intItem = x Then 'Not equal, we must
keep this one in the list
Redim Preserve tmpValueList(intItemCnt)
tmpValueList(intItemCnt) = ValueList(x)
intItemCnt = intItemCnt + 1 ' Count the
items we have kept so that we can adjust the array properly
End If
Next
RemoveItemFromList = tmpValueList

End Function

Function EntryInList (Value As Variant, ValueList As Variant) As Integer
' This will return a 1 based value if the position in the list
EntryInList = 0
i = 1
Forall Entries In ValueList
If Entries = Value Then
EntryInList = i
Exit Function
End If
i = i + 1
End Forall
End Function

Function RemoveRangeFromList (intStartPos As Integer, intEndPos As Integer,
varInput As Variant) As Variant
Dim tmpList() As Variant
Dim intPosCnt As Integer
intPosCnt = 0
For i = 0 To Ubound(varInput)
If i < intStartPos Or i > intEndPos Then
Redim Preserve tmpList(intPosCnt)
tmpList(intPosCnt) = varInput(i)
intPosCnt = intPosCnt + 1
End If
Next
RemoveRangeFromList = tmpList
End Function

URL: http://searchdomino.techtarget.com/tip/0,289483,sid4_gci490542,00.html

Nenhum comentário:

Postar um comentário