Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.04.2024 21:55:37
Preiserhöhung über mehrere Jahre berechnen
17.04.2024 20:19:32
Endzeitpunkt berechnen aus d:hh:mm errechnen
17.04.2024 18:57:33
Errinnerungsfunktion
17.04.2024 16:56:58
Stunden addieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1336to1340
1336to1340
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Listboxeintrag über Textbox filtern

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

Cursor springt in die Pampa - MultiLine TextBox
Kilo

Hallo liebe VBA Profis
ich bin auf ein für mich nicht lösbares Problem - vielleicht sogar Phänomen gestoßen...
Leider kann ich keine Phänomene dieser Art gebrauchen.
Damit es für Sie etwas anschaulicher wird, hab ich mein Problem als Beispiel (https://www.herber.de/bbs/user/54427.xl...
07.08.2008 20:31:08
Thread-ID: 1000095
2 Beiträge
Anzeige
Cursor springt in Pampa (MultiLine TextBox)
Kilo

Hallo liebe VBA Profis
(Danke an Jürgen, der sich meines Problems annehmen wollte, aber der UpLoad meiner Datei war irgendwie fehlgeschlagen - hier der 2. Versuch)
ich bin auf ein für mich nicht lösbares Problem - vielleicht sogar Phänomen gestoßen...
Leider kann ich keine Phänomene...
11.08.2008 12:15:00
Thread-ID: 1000795
5 Beiträge
In derTextBox das Format ändern
edie

Hallo zusammen,
würde gerne, wenn es möglich wäre, das Datum in der TextBox im Format TT.MM.YYYY
zurückschreibe in die Zelle A1 im Format YYYY-MM-TT 00:00 z. B. 2008-07-01 00:00
Wenn es möglich ist dann wie?
Hat jemand eine Idee und kann weiter helfen?
Danke im Voraus.
...
13.08.2008 15:27:49
Thread-ID: 1001560
3 Beiträge
Anzeige
Hintergrundfärbung in UserForm Textbox in Zelle...
Josef

Guten Morgen!
wie ich Daten über Userform TextBoxen in die Zellen zurückschreibe, dafür habe ich bereits eine Lösung.
Is es jedoch möglich einen gefärbten Hintergrund einer TextBox in die dafür vorgesehene Zelle zu übertragen?
Wenn ja, wie würde dann bitte eine VBA Lösung lauten?
28.08.2008 06:57:47
Thread-ID: 1005257
10 Beiträge
Höhe einer Textbox nach Grafik ausrichten
TomTom

Hi,
ich habe eine Frage zur Ausrichtung einer Textbox: Ich habe auf meinem Sheet ein paar Textboxen (untereinender) die je nach Grösse und Inhalt zueinander in Höhe ausgerichtet werden (Makro)
Ganz unten im Sheet habe ich sowas , wie eine Fusszeile eingefügt, eine kleine Grafik (jpg, ei...
04.09.2008 11:19:00
Thread-ID: 1007335
5 Beiträge
Fokus in Textbox und Curser hinter Text
Reinhard

Hallo Wissende,
Autofilter "vergißt" einige Zeilen wenn mehr als 1000 unterschiedliche Listeneinträge da sind.
Deshalb bastelte ich mir folgenden Code. man hat im Blatt eine TextBox und eine Listbox. Je nach Eingabe in die Textbox erscheinen in der Listbox nur die Einträge die anfangs s...
12.09.2008 12:14:38
Thread-ID: 1009326
6 Beiträge
Externen Datensatz in TextBox einfügen
Wolfgang

Hallo,
Nachdem ich Ihr mir schon einmal sehr geholfen habt, versuche ich es noch einmal:
Ein Datensatz wird aus einer Datenbank (keine Access-Datenbank) ins Clipboard kopiert, danach in Excel eine UserForm mit einer TextBox geöffnet, die den Datensatz aufnehmen und danach an ein Excel-T...
19.09.2008 16:28:23
Thread-ID: 1011092
8 Beiträge
Druckerauswahl in TextBox 'auslagern'
Henner

Hi,
ich drucke (erzeuge) in meiner Mappe über den folgenden Code (ein PDF File):
Sub Print() Application.ActivePrinter = "FreePDF XP auf Ne02:" ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _ "FreePDF XP auf Ne02:", Collate:=True Application.ActivePrinter = "Brother...
07.10.2008 11:58:00
Thread-ID: 1014674
2 Beiträge
Anzeige

Links zu Excel-Dialogen

ListBox TextBox

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige
Archiv - Verwandte Themen
Forumthread
Beiträge
1
6
4
2
4
9
4
5
7
1
2
2
2
2
3
3
1
4
9
9
2
2
5
2
1