Anzeige
Archiv - Navigation
924to928
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
924to928
924to928
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Listbox füllen ohne Duplikaten und leerzelle
18.11.2007 14:33:53
Karel
Hallo Forum,
Habe unterstehende makro in Forum gefunden, und ein bisschen angepasst, brauche nur Suche in Spalte C
(genau bereich C3:C5000)
wie kann ich diese listbox füllen ohne Duplikate und leerzellen beispiel https://www.herber.de/bbs/user/47837.xls

Private Sub TextBox1_Change()
Dim arr() As Variant
Dim index As Integer
Dim iCount As Integer
Dim X As Long
X = Sheets("Tabelle1").Cells(Rows.Count, "C").End(xlUp).Row
If TextBox1.Value = "" Then
ListBox1.RowSource = "C3:C" & X
Exit Sub
End If
ListBox1.RowSource = ""
ListBox1.Clear
iCount = 0
For index = 3 To X
If LCase(Left(Cells(index, 3), Len(TextBox1))) = LCase(TextBox1) Then
If Sheets("Tabelle1").Cells(index, 3)  "" Then
On Error Resume Next
ReDim Preserve arr(1, iCount)
arr(0, iCount) = Cells(index, 3).Value
'arr(1, iCount) = Cells(index, 4).Value
'arr(2, iCount) = Cells(index, 5).Value
iCount = iCount + 1
End If
End If
Next
ListBox1.Column = arr
End Sub


Grusse
Karel

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Listbox füllen ohne Duplikaten und leerzelle
18.11.2007 17:01:35
Gerd
Hallo Karel,
setze bitte im Eigenschaften-Fenster bei der Listbox1 ColumnCount auf "1" .

Private Sub TextBox1_Change()
Dim var As Variant, arr() As Variant, arr2() As Variant
Dim index As Long, iCount As Long, X As Long
X = Sheets("Tabelle1").Cells(Rows.Count, "C").End(xlUp).Row
var = Sheets("Tabelle1").Range("C3:C" & X).SpecialCells(xlCellTypeConstants)
ReDim arr(0)
arr(0) = "#"
For iCount = 1 To UBound(var)
If Not IsNumeric(Application.Match(var(iCount, 1), arr, 0)) Then
ReDim Preserve arr(IIf(arr(0) = "#", 0, UBound(arr) + 1))
arr(UBound(arr)) = var(iCount, 1)
End If
Next
ListBox1.Clear
If TextBox1.Value = "" Then
ListBox1.List = arr
Exit Sub
End If
iCount = 0
ReDim arr2(0)
arr2(0) = " "
For index = 0 To UBound(arr)
If LCase(Left(arr(index), Len(TextBox1))) = LCase(TextBox1) Then
ReDim Preserve arr2(iCount)
arr2(iCount) = arr(index)
iCount = iCount + 1
End If
Next
ListBox1.List = arr2
End Sub


Gruß Gerd

Anzeige
AW: Listbox füllen ohne Duplikaten und leerzelle
18.11.2007 22:38:00
Karel
Hallo Gerd,
Benutzen deine variante, ihr liefert kein Fehler bei eingabe in suchfeld (bei unbekannte werten)
habe noch eine Fragen, wie kan man beim öffnen von Userform, die Listbox direkt fullen und sortiert anzeigen.
Sortier makro hab ich und Funktioniert auch wenn ich im Textfeld buchstabe eingeben.

Private Sub TextBox1_Change()
Dim var As Variant, arr() As Variant, arr2() As Variant
Dim index As Long, iCount As Long, X As Long
X = Sheets("Tabelle1").Cells(Rows.Count, "C").End(xlUp).Row
var = Sheets("Tabelle1").Range("C8:C" & X).SpecialCells(xlCellTypeConstants)
ReDim arr(0)
arr(0) = "#"
For iCount = 1 To UBound(var)
If Not IsNumeric(Application.Match(var(iCount, 1), arr, 0)) Then
ReDim Preserve arr(IIf(arr(0) = "#", 0, UBound(arr) + 1))
arr(UBound(arr)) = var(iCount, 1)
End If
Next
ListBox1.Clear
If TextBox1.Value = "" Then
ListBox1.List = arr
Exit Sub
End If
iCount = 0
ReDim arr2(0)
arr2(0) = " "
For index = 0 To UBound(arr)
If LCase(Left(arr(index), Len(TextBox1))) = LCase(TextBox1) Then
ReDim Preserve arr2(iCount)
arr2(iCount) = arr(index)
iCount = iCount + 1
End If
Next
ListBox1.List = arr2
Call Sortieren
End Sub


_______________________________________________________________
Sub Sortieren()
Dim Letzter As Integer, Naechster As Integer
Dim i As String
With ListBox1
For Letzter = 0 To .ListCount - 1
For Naechster = Letzter + 1 To .ListCount - 1
If .List(Letzter) > .List(Naechster) Then
i = .List(Letzter)
.List(Letzter) = .List(Naechster)
.List(Naechster) = i
End If
Next Naechster
Next Letzter
End With
End Sub


und kannst du mir diese anschnitt erlautern
For iCount = 1 To UBound(var)
If Not IsNumeric(Application.Match(var(iCount, 1), arr, 0)) Then
ReDim Preserve arr(IIf(arr(0) = "#", 0, UBound(arr) + 1))
arr(UBound(arr)) = var(iCount, 1)
Grusse
Karel

Anzeige
AW: erledigt
21.11.2007 20:01:00
Karel
erledigt
Karel

232 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige