Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
664to668
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
664to668
664to668
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

List Box

List Box
13.09.2005 13:43:28
Thomas
Hallo Liebe Excel Freunde !
Ich habe ein kleines Probelem,
Wie bekomme ich hin das ich in einer ListBox die Doppelten Einträge
unterdrücken kann, also nicht löschen und um zum Beispiel nur
einen Straßennamen nur einmal anzuzeigen....
Wer kann mir da helfen ?
Gruß
Thomas

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: List Box
13.09.2005 15:34:42
GraFri
Hallo
Vielleicht hilft dir folgender Code weiter. Mit dieser Routine aus einem bestehenden Programm kann man Daten aus einem Tabellenblatt ohne Duplikate in ein Datenarray einlesen und dieses auch sortieren. Deinen Bedürfnissen anpassen.


      
'******************************************************************************
'In ein Modul

Option Explicit
Public suchDaten()      'Daten, die in der Listbox 'lisSuche' angezeigt werden
Public listDaten()      'Daten, die in der Listbox 'lisAnzeige' angezeigt werden
Public n&
Public von&, bis&       'Anfangs- und Endzeie des Bereiches
Dim AnzAlle As Long, AnzOhneDupl As Long
Sub EntferneDuplikate(Adresse As String)
Dim AlleZellen As Range, Zelle As Range
Dim OhneDupl As New Collection
Dim i As Long, j As Long
Dim Swap1, Swap2, Item
    
' Daten stehen im Bereich 'Adresse'
    Set AlleZellen = Range(Adresse)
    
' Anfangs- und Endzeie des Bereiches
    von = AlleZellen.Row
    bis = von + AlleZellen.Count - 1
    
' Der nächste Abschnitt ignoriert den Fehler, der entsteht, wenn
' versucht wird, ein Duplikat in die Collection zu schreiben. Das
' Duplikat wird nicht geschrieben - das was wir wollen.
    On Error Resume Next
    
For Each Zelle In AlleZellen
        OhneDupl.Add Zelle.Value, 
CStr(Zelle.Value)
'       Beachte: das 2te Argument für die Add Methode muß ein String sein
    Next Zelle
' Normale Fehlerbehandlung
    On Error GoTo 0
' Anzahl aller Daten und Daten ohne Duplikate
    AnzAlle = AlleZellen.Count
    AnzOhneDupl = OhneDupl.Count
    
' Sortieren der Collection (optional)
    For i = 1 To OhneDupl.Count - 1
        
For j = i + 1 To OhneDupl.Count
            
If OhneDupl(i) > OhneDupl(j) Then
                Swap1 = OhneDupl(i)
                Swap2 = OhneDupl(j)
                OhneDupl.Add Swap1, before:=j
                OhneDupl.Add Swap2, before:=i
                OhneDupl.Remove i + 1
                OhneDupl.Remove j + 1
            
End If
        
Next j
    
Next i
    
' Die sortierten Daten (ohne Duplikate) in das DatenArray
    ReDim suchDaten(0 To AnzOhneDupl - 1) ' Dimensionieren
    
    
For n = 0 To UBound(suchDaten)
        suchDaten(n) = OhneDupl.Item(n + 1)
    
Next n
    
' Die sortierten Daten direkt (ohne Duplikate) in die ListBox
'    For Each Item In OhneDupl
'        UserForm1.lisSuche.AddItem Item
'    Next Item

End Sub
mfg, GraFri
Anzeige
AW: List Box
13.09.2005 15:37:11
GraFri
Hallo
Etwas einfacher.


      
Option Explicit
Sub OhneduplikatesortiertinListbox()
Dim OhneDuplikate   As New Collection
Dim ZellBereich     As Range
Dim Zelle           As Range
Dim i&, j&
Dim Parken1, Parken2, Element
Set ZellBereich = Worksheets("Tabelle1").Range("A1:A3500")
On Error Resume Next
For Each Zelle In ZellBereich
    OhneDuplikate.Add Zelle.Value, 
CStr(Zelle.Value)
Next Zelle
'   Sortierung der Collection
For i = 1 To OhneDuplikate.Count - 1
    
For j = i + 1 To OhneDuplikate.Count
        
If OhneDuplikate(i) > OhneDuplikate(j) Then
            Parken1 = OhneDuplikate(i)
            Parken2 = OhneDuplikate(j)
            
'Tauschen der falsch sortierten
            OhneDuplikate.Add Parken1, before:=j
            OhneDuplikate.Add Parken2, before:=i
            OhneDuplikate.Remove i + 1
            OhneDuplikate.Remove j + 1
        
End If
    
Next j
Next i
'Füllen der ListBox
For Each Element In OhneDuplikate
    UserForm1.ListBox1.AddItem Element
Next Element
mfg, GraFri
Anzeige
AW: List Box
13.09.2005 18:44:10
Thomas
Danke für deine Hilfe!!!
Genau das habe ich gesucht, hat gleich geklappt...
Gruß
Thomas

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige