|
credo che il problema sia in un Array filtrato. Posto il codice:
Private Sub prova1()
On Error Resume Next
Dim MyColl As Collection
Dim X As Integer, j As Integer
Dim Duplicati As Single
Set MyColl = New Collection
For X = LBound(MyArray) To UBound(MyArray)
'Cerco d'aggiungere l'elemento come chiave alla collection:
MyColl.Add 0, CStr(MyArray(X))
'La chiave esiste già, quindi è un duplicato la inserisco nella List2:
If Err Then
List2.AddItem MyArray(X)
' Toglie i duplicati:
MyArray(X) = Empty
Duplicati = Duplicati + 1
Err.Clear
ElseIf Duplicati Then
'ricompatta l'array :
MyArray(X - Duplicati) = MyArray(X)
MyArray(X) = Empty
End If
Next
'Toglie dall'array i valori "empty" - Numeri doppi e tripli inseriti in List1:
If Duplicati Then
ReDim Preserve MyArray(LBound(MyArray) To UBound(MyArray) - Duplicati) As Single
End If
' Ordina i numeri singoli del vettore:
Call BubbleSort
' Rimuove da List2 i numeri doppi e li inserisce in List3:
Call RimuoviDupl(List2)
Set MyColl = Nothing
End Sub
'------------------------------------------------
' Ordina in senso crescente i singoli elementi contenuti nella Lbl:
Sub BubbleSort()
Dim ii As Integer, j As Integer, y As Integer, Temp As String, risult2 As String
For ii = UBound(MyArray, 1) To LBound(MyArray, 1) Step -1
For j = LBound(MyArray, 1) To ii - 1
'scambiare il ">" con "<" per ottenere un ordinamento decrescente:
If MyArray(j) > MyArray(j + 1) Then
Temp = MyArray(j)
MyArray(j) = MyArray(j + 1)
MyArray(j + 1) = Temp
End If
Next j
Next ii
' Visualizza i numeri singoli in una Lbl:
For y = 0 To UBound(MyArray)
risult2 = risult2 & Space(2) & MyArray(y)
Next y
' Label6(7).Caption = risult2
End Sub
'------------------------------------------------
' Rimuove i numeri doppi dalla List2 e li inserisce in List3:
Sub RimuoviDupl(LB As ListBox)
Dim c As New Collection
Dim X As Long
Dim y As String
Dim j As Integer
Dim jj As Integer
Dim NC As Single
On Error Resume Next
If LB.ListCount > 1 Then
For X = 0 To LB.ListCount - 1
y = LB.List(X)
c.Add y, y
If Err Then
List3.AddItem c.Item(y)
Err.Clear
End If
Next X
LB.Clear
For X = 1 To c.count
LB.AddItem c.Item(X)
Next X
' Elimina da List2 i numeri contenuti in List3 (Tripli):
For j = 0 To (List3.ListCount - 1)
NC = List3.List(j)
For jj = 0 To (List2.ListCount - 1)
If List2.List(jj) = NC Then
List2.RemoveItem (jj)
End If
Next jj
Next j
End If
Set c = Nothing
End Sub
| 
| 
