Unique values from range

From Training Material
Jump to: navigation, search


 Sub UniqueValues_Collection()
 
 Dim komorka As Range, wynik As String, licznik As Integer
 Dim UnikalnaWartosc As New Collection
 On Error Resume Next
 
     For Each komorka In Selection
         UnikalnaWartosc.Add komorka.Value, CStr(komorka.Value)
         If Err.Number = 0 Then
             licznik = licznik + 1
             wynik = wynik & UnikalnaWartosc(licznik)
         End If
       ERR.CLEAR
     Next
 
 MsgBox wynik
 
 End Sub


Przed użyciem słownika zainstaluj bibliotekę Microsoft Scripting Runtime


Sub UniqueValues_dictionary()
Dim UnikalnaWartosc As Dictionary
Dim komorka As Range, wynik As String, licznik As Integer, x

Set UnikalnaWartosc = New Scripting.Dictionary

    For Each komorka In Selection
        
        If Not UnikalnaWartosc.Exists(komorka.Value) Then
            UnikalnaWartosc.Add komorka.Value, komorka
        End If
    Next

    MsgBox Join(UnikalnaWartosc.Keys, vbCrLf)

End Sub