Unique values from range

From Training Material
Jump to navigation Jump to search
The printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.


 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