Thema: Doppel aus Liste entfernen

StandardModule: Modul1

Sub Onlys()
   Dim arr() As Variant
   Dim arrOnlys As Variant
   Dim iRow As Integer, iCount As Integer
   iCount = Selection.Cells.Count
   If iCount = 1 Then
      Beep
      MsgBox "Sie müssen mindestens 2 Zellen auswählen!"
      Exit Sub
   End If
   ReDim arr(1 To iCount)
   For iRow = 1 To iCount
      arr(iRow) = Selection.Cells(iRow).Value
   Next iRow
   arrOnlys = GetOnlys(arr)
   Columns(2).ClearContents
   For iRow = 1 To UBound(arrOnlys)
      Cells(iRow, 2).Value = arrOnlys(iRow)
   Next iRow
End Sub

Private Function GetOnlys(arr As Variant) As Variant
   Dim col As New Collection
   Dim arrNew()
   Dim iRow As Integer
   On Error Resume Next
   For iRow = LBound(arr) To UBound(arr)
      col.Add Item:=arr(iRow), key:=arr(iRow)
   Next iRow
   On Error GoTo 0
   ReDim Preserve arrNew(1 To col.Count)
   For iRow = 1 To col.Count
      arrNew(iRow) = col(iRow)
   Next iRow
   GetOnlys = arrNew
End Function

Beiträge aus dem Excel-Forum zu den Themen Allgemein und Liste