Unique values from range
Jump to navigation
Jump to 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