Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1336to1340
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
Listboxeintrag über Textbox filtern
22.11.2013 03:22:23
Werner
Hallo Experten,
ich lese mit folgendem Code Daten aus einer Tabelle in eine mehrspaltige Listbox ein:
Private Sub UserForm_Activate()
Application.ScreenUpdating = False
Nachname = ""
Vorname = ""
GDatum = ""
Dim X As Long
Dim I As Integer
Application.ScreenUpdating = False
Worksheets("Jahrestabelle").Activate
Me.Personalien.Clear
X = Range("D" & Rows.Count).End(xlUp).Row
For I = 5 To X
Me.Personalien.AddItem
Personalien.List(Personalien.ListCount - 1, 0) = Cells(I, 4)
Personalien.List(Personalien.ListCount - 1, 1) = Cells(I, 5)
Personalien.List(Personalien.ListCount - 1, 2) = Cells(I, 6)
Personalien.List(Personalien.ListCount - 1, 3) = Cells(I, 8)
Personalien.List(Personalien.ListCount - 1, 4) = Cells(I, 9)
Personalien.List(Personalien.ListCount - 1, 5) = Cells(I, 10)
Personalien.List(Personalien.ListCount - 1, 6) = Cells(I, 11)
Personalien.List(Personalien.ListCount - 1, 7) = Cells(I, 12)
Personalien.List(Personalien.ListCount - 1, 8) = Cells(I, 13)
Personalien.List(Personalien.ListCount - 1, 9) = I
Next I
Application.ScreenUpdating = True
End Sub
Nun möchte ich die Spalten 0, 1 und 2 der Listbox durch Eingaben in drei Textboxen filtern. Kriege es leider nicht hin. Könnt ihr mir bitte helfen.
Grüße Werner

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Listboxeintrag über Textbox filtern
22.11.2013 09:23:04
Tino
Hallo,
ich habe es mal so versucht.
Gefiltert wird nach dem Anfang der entsprechenden TextBox.
Wenn der Text auch in der mitte stehen kann, mach aus
sFilter1 = sFilter1 & "*"
einfach
sFilter1 = "*" & sFilter1 & "*"
Private Sub TextBox1_Change()
Call FilterDaten(TextBox1, TextBox2, TextBox3)
End Sub

Private Sub TextBox2_Change()
Call FilterDaten(TextBox1, TextBox2, TextBox3)
End Sub

Private Sub TextBox3_Change()
Call FilterDaten(TextBox1, TextBox2, TextBox3)
End Sub

Private Sub UserForm_Activate()
Call FilterDaten
End Sub

Private Sub FilterDaten(Optional sFilter1$, Optional sFilter2$, Optional sFilter3$)
Dim ArData, ArFilter()
Dim X As Long, n&, nn&, nCount&

Me.Personalien.Clear
With Worksheets("Jahrestabelle")
    X = Range("D" & Rows.Count).End(xlUp).Row
    If X < 5 Then Exit Sub
    ArData = .Range("D5", .Cells(X, 13))
End With

Redim Preserve ArFilter(1 To Ubound(ArData, 2) + 1, 1 To Ubound(ArData) + 1)

If sFilter1 & sFilter2 & sFilter3 = "" Then
    For n = 1 To Ubound(ArData)
        nCount = nCount + 1
        For nn = 1 To Ubound(ArData, 2) - 1
            ArFilter(nn, nCount) = ArData(n, nn)
        Next nn
        ArFilter(nn, nCount) = n + 4
    Next n
Else
    sFilter1 = sFilter1 & "*"
    sFilter2 = sFilter2 & "*"
    sFilter3 = sFilter3 & "*"
    
    For n = 1 To Ubound(ArData)
        If ArData(n, 1) Like sFilter1 Then
            If ArData(n, 2) Like sFilter2 Then
                If ArData(n, 3) Like sFilter3 Then
                    nCount = nCount + 1
                    For nn = 1 To Ubound(ArData, 2) - 1
                        ArFilter(nn, nCount) = ArData(n, nn)
                    Next nn
                    ArFilter(nn, nCount) = n + 4
                End If
            End If
        End If
    Next n
End If

If nCount > 0 Then
    Personalien.ColumnCount = Ubound(ArFilter)
    Personalien.List = Application.Transpose(ArFilter)
Else
    MsgBox "keine Daten gefunden"
End If
End Sub
Gruß Tino

Anzeige
AW: Listboxeintrag über Textbox filtern
22.11.2013 15:34:00
Werner
Hallo Tino,
danke für deine Hilfe. Habe deinen Code eigebaut und es funktioniert wunderbar. So wie ich mir das vorgestellt habe.
Vielleicht kannst du mir aber bei einer weiteren Sache weiter helfen. Mit meinem obigen Code lese ich ja die Daten aus der Jahrestabelle in die Listbox ein. Hierbei lese ich unter .ListCount -1,9 auch die entsprechende Zeilennummer mit in die Listbox ein.
Den ausgewählten Eintrag aus der Listbox übergebe ich dann an insgesamt 10 Textboxen (wobei hierbei in der Textbox 10 dann die Zeilennummer steht) damit ich dort die Daten ggf. ändern kann.
Nun möchte ich den geänderten Datensatz wieder an die Tabelle übergeben und dabei den alten Datensatz überschreiben. Hierzu möchte ich die Zeilennummer aus der Textbox 10 nutzen. Dort ist ja hinterlegt, wo der Datensatz in der Tabelle steht, den ich gerade geändert habe.
Ich kriege es aber leider mal wieder nicht hin.
Gruß Werner

Anzeige
AW: Listboxeintrag über Textbox filtern
22.11.2013 18:06:12
Werner
Hallo,
ich habe es jetzt vorläufig mal so probiert:
Private Sub Ändern_Click()
Dim ZielZeile As Variant
Set ZielZeile = Veränderungen.Zeile.Text
Application.ScreenUpdating = False
Worksheets("Jahrestabelle").Unprotect Password:="*****"
Worksheets("Jahrestabelle").Activate
Worksheets("Jahrestabelle").Cells(ZielZeile, 4) = Familienname.Text
Worksheets("Jahrestabelle").Cells(ZielZeile, 5) = Vorname.Text
Worksheets("Jahrestabelle").Cells(ZielZeile, 6) = CDate(GebDatum)
Worksheets("Jahrestabelle").Cells(ZielZeile, 8) = CDate(Datum)
Worksheets("Jahrestabelle").Cells(ZielZeile, 9) = Störung.Text
Worksheets("Jahrestabelle").Cells(ZielZeile, 10) = Straftat.Text
Worksheets("Jahrestabelle").Cells(ZielZeile, 11) = Verweis.Text
Worksheets("Jahrestabelle").Cells(ZielZeile, 12) = OE.Text
Worksheets("Jahrestabelle").Cells(ZielZeile, 13) = Eigene.Text
Familienname = ""
Vorname = ""
GebDatum = ""
Datum = ""
Störung = ""
Straftat = ""
Verweis = ""
OE = ""
Eigene = ""
Zeile = ""
Unload Me
Range("D5").Select
Worksheets("Jahrestabelle").Protect Password:="*****"
Worksheets("Dateneingabe").Activate
Application.ScreenUpdating = True
Das funktioniert auch so lange ich in der ListBox scrolle und einen Eintrag auswähle. Dann übernimmt er mir die korrekte Zeilennummer in die TextBox.
Sobald ich aber über die TextBoxen die ListBox filtere stimmt es aber nicht mehr.
Gruß Werner

Anzeige
AW: Listboxeintrag über Textbox filtern
22.11.2013 18:31:32
Tino
Hallo,
kann erst morgen antwort geben, bin nicht am PC.
Gruß Tino

hier ein Vorschlag...
23.11.2013 11:31:39
Tino
Hallo,
kannst mal so versuchen.
In der Sub FilterDaten kommt noch diese Zeile hinzu.
ReDim Preserve ArFilter(1 To UBound(ArFilter), 1 To nCount)
Private Sub Ändern_Click()
Dim ZielZeile As Long
'kein Datensatz ausgewählt 
If Personalien.ListIndex = -1 Then Exit Sub
'Zeile aus Listbox auslesen 
If IsNumeric(Personalien.List(, 9)) Then
    ZielZeile = Personalien.List(, 9)
Else 'Eintrag hat keine Zeilennummer (sollte aber nicht vorkommen!) 
    Exit Sub
End If

On Error GoTo ErrFehler:
Application.ScreenUpdating = False
With Worksheets("Jahrestabelle")
    .Protect Password:="*****", UserInterfaceonly:=True
    .Cells(ZielZeile, 4) = Familienname.Text
    .Cells(ZielZeile, 5) = Vorname.Text
    .Cells(ZielZeile, 6) = CDate(GebDatum)
    .Cells(ZielZeile, 8) = CDate(Datum)
    .Cells(ZielZeile, 9) = Störung.Text
    .Cells(ZielZeile, 10) = Straftat.Text
    .Cells(ZielZeile, 11) = Verweis.Text
    .Cells(ZielZeile, 12) = OE.Text
    .Cells(ZielZeile, 13) = Eigene.Text
End With

ErrFehler:
Unload Me
Worksheets("Dateneingabe").Activate
Application.ScreenUpdating = True

If Err.Number <> 0 Then
    MsgBox Err.Description, _
           vbCritical + vbMsgBoxSetForeground + vbMsgBoxHelpButton, _
           "Error: " & Err.Number, Err.HelpFile, Err.HelpContext
End If
End Sub

Private Sub TextBox1_Change()
Call FilterDaten(TextBox1, TextBox2, TextBox3)
End Sub

Private Sub TextBox2_Change()
Call FilterDaten(TextBox1, TextBox2, TextBox3)
End Sub

Private Sub TextBox3_Change()
Call FilterDaten(TextBox1, TextBox2, TextBox3)
End Sub

Private Sub UserForm_Activate()
Call FilterDaten
End Sub

Private Sub FilterDaten(Optional sFilter1$, Optional sFilter2$, Optional sFilter3$)
Dim ArData, ArFilter()
Dim X As Long, n&, nn&, nCount&

Me.Personalien.Clear
With Worksheets("Jahrestabelle")
    X = Range("D" & Rows.Count).End(xlUp).Row
    If X < 5 Then Exit Sub
    ArData = .Range("D5", .Cells(X, 13))
End With

Redim Preserve ArFilter(1 To Ubound(ArData, 2) + 1, 1 To Ubound(ArData) + 1)

If sFilter1 & sFilter2 & sFilter3 = "" Then
    For n = 1 To Ubound(ArData)
        nCount = nCount + 1
        For nn = 1 To Ubound(ArData, 2) - 1
            ArFilter(nn, nCount) = ArData(n, nn)
        Next nn
        ArFilter(nn, nCount) = n + 4
    Next n
Else
    sFilter1 = sFilter1 & "*"
    sFilter2 = sFilter2 & "*"
    sFilter3 = sFilter3 & "*"
    
    For n = 1 To Ubound(ArData)
        If ArData(n, 1) Like sFilter1 Then
            If ArData(n, 2) Like sFilter2 Then
                If ArData(n, 3) Like sFilter3 Then
                    nCount = nCount + 1
                    For nn = 1 To Ubound(ArData, 2) - 1
                        ArFilter(nn, nCount) = ArData(n, nn)
                    Next nn
                    ArFilter(nn, nCount) = n + 4
                End If
            End If
        End If
    Next n
End If

If nCount > 0 Then
    Redim Preserve ArFilter(1 To Ubound(ArFilter), 1 To nCount)
    Personalien.ColumnCount = Ubound(ArFilter)
    Personalien.List = Application.Transpose(ArFilter)
Else
    MsgBox "keine Daten gefunden"
End If
End Sub
Gruß Tino

Anzeige
AW: hier ein Vorschlag...
23.11.2013 14:52:53
Werner
Hallo Tino,
danke für die Unterstützung. Ich hätte aber nochein kleines Problem. Ist es möglich beim Code für das Filtern der Listbox-Einträge dies auch nur für bestimmte Reihen zu machen. So wie es in deinem Code steht wirkt sich das ja für den ganzen Bereich D5 bis M5 aus hier die Zeile
ArData = .Range("D5", .Cells(X, 13))
Ich möchte aber .Cells(X, 7) nicht mit drin haben. Das ganze sollte sich also nur für
.cells(X,4) .cells(X,5) .cells(X,8) .cells(X,9) .cells(X,10) .cells(X,11) .cells(X,12) .cells(X,13)
erstrecken. Ist das in diesem Kontext überhaupt möglich?
Gruß Werner

Anzeige
AW: hier ein Vorschlag...
23.11.2013 15:39:50
Tino
Hallo,
kannst mal so testen.
In der Zeile varNotSpalte = Array(7) kannst Du die Spalten anpassen die ausgelassen werden sollen.
Soll zBsp. noch die Spalte 9 ausgelassen werden dann varNotSpalte = Array(7, 9)
Die Spalten müssen aber innerhalb vom Range liegen, also hier Spalte 4 bis 13.
Der Offset fürs Array wird im Code berechnen,
weil im Array ArData die Spalte 1 in der Tabelle die Spalte 4 ist!
Private Sub FilterDaten(Optional sFilter1$, Optional sFilter2$, Optional sFilter3$)
Dim ArData, ArFilter()
Dim X As Long, n&, nn&, nCount&, nRow&
Dim varNotSpalte
'Spalten auslassen entsprechend auffüllen Array(7,10) 
'Spalte muss sich innerhalb .Range("D5", .Cells(X, 13)) also hier Spalte 4 bis 13 befinden!!!! 
varNotSpalte = Array(7, 9)

Me.Personalien.Clear
With Worksheets("Jahrestabelle")
    X = Range("D" & Rows.Count).End(xlUp).Row
    If X < 5 Then Exit Sub
    With .Range("D5", .Cells(X, 13))
        ArData = .Value
        nRow = .Columns(1).Column - 1
    End With
End With
For X = Lbound(varNotSpalte) To Ubound(varNotSpalte)
    varNotSpalte(X) = varNotSpalte(X) - nRow
Next X
Redim Preserve ArFilter(1 To Ubound(ArData, 2) + 1, 1 To Ubound(ArData) + 1)

If sFilter1 & sFilter2 & sFilter3 = "" Then
    For n = 1 To Ubound(ArData)
        nCount = nCount + 1
        nRow = 0
        For nn = 1 To Ubound(ArData, 2) - 1
            If Not IsNumeric(Application.Match(nn, varNotSpalte, 0)) Then
                nRow = nRow + 1
                ArFilter(nRow, nCount) = ArData(n, nn)
            End If
        Next nn
        nRow = nRow + 1
        ArFilter(nRow, nCount) = n + 4
    Next n
Else
    sFilter1 = sFilter1 & "*"
    sFilter2 = sFilter2 & "*"
    sFilter3 = sFilter3 & "*"
    
    For n = 1 To Ubound(ArData)
        If ArData(n, 1) Like sFilter1 Then
            If ArData(n, 2) Like sFilter2 Then
                If ArData(n, 3) Like sFilter3 Then
                    nCount = nCount + 1
                    nRow = 0
                    For nn = 1 To Ubound(ArData, 2) - 1
                        If Not IsNumeric(Application.Match(nn, varNotSpalte, 0)) Then
                            nRow = nRow + 1
                            ArFilter(nRow, nCount) = ArData(n, nn)
                        End If
                    Next nn
                    nRow = nRow + 1
                    ArFilter(nRow, nCount) = n + 4
                End If
            End If
        End If
    Next n
End If

If nCount > 0 Then
    Redim Preserve ArFilter(1 To Ubound(ArFilter), 1 To nCount)
    ArFilter = Application.Transpose(ArFilter)
    Redim Preserve ArFilter(1 To Ubound(ArFilter), 1 To Ubound(ArFilter, 2) - (Ubound(varNotSpalte) + 1))
    Personalien.ColumnCount = Ubound(ArFilter, 2)
    Personalien.List = ArFilter
Else
    MsgBox "keine Daten gefunden"
End If
End Sub
Gruß Tino

Anzeige
AW: Listboxeintrag über Textbox filtern
22.11.2013 10:51:30
Rudi
Hallo,
mein Vorschlag:
Private Sub UserForm_Activate()
Application.ScreenUpdating = False
Nachname = ""
Vorname = ""
GDatum = ""
With Personalien
.ColumnCount = 10
.Column = PersArray(Nachname, Vorname, GDatum)
End With
Application.ScreenUpdating = True
End Sub
Private Sub Nachname_Change()
Dim arr
arr = PersArray(Nachname, Vorname, GDatum)
Personalien.Clear
If IsArray(arr) Then Personalien.Column = arr
End Sub
Private Sub Vorname_Change()
Dim arr
arr = PersArray(Nachname, Vorname, GDatum)
Personalien.Clear
If IsArray(arr) Then Personalien.Column = arr
End Sub
Private Sub GDatum_Change()
Dim arr
arr = PersArray(Nachname, Vorname, GDatum)
Personalien.Clear
If IsArray(arr) Then Personalien.Column = arr
End Sub
Function PersArray(sFilter1 As String, sFilter2 As String, sFilter3 As String)
Dim arrAlles, i As Long, j As Long, n As Long, arrTmp(), X As Long
X = Worksheets("Jahrestabelle").Range("D" & Rows.Count).End(xlUp).Row
If X 

Gruß
Rudi

Anzeige
AW: Listboxeintrag über Textbox filtern
24.11.2013 12:45:32
Werner
Hallo Rudi,
ich habe es jetzt mit deinem Code hinbekommen. Herzlichen Dank für die Unterstützung.
Ich lese jetzt zusätzlich noch die Zeilennummer mit aus und schreibe dann die geänderten Daten der Textboxen an diese Zeilennummer zurück. Über deine Filterroutine zählt er mir zwar die Zeilennummern von 1-.... zu den Listboxeinträgen (obwohl der erste Eintrag ja in Zeile 5 steht). Ich zähle dann einfach vier dazu und schreibe es dann zurück. Ist wohl nicht gerade die eleganteste Lösung aber es funktioniert.
Danke, Werner

303 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige