Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

VBA Listbox füllen nach Kriterium
#1
Hallo zusammen, einen schönen 1.Advent
Nun zum Problem , ich habe eine Userform , dort eine Textbox6 wo ein Datum eingetragen wird.
Jetzt möchte ich gern nach dem Eintag, das eine Listbox2 mir alle Einträge aus der Spalte 25 (Y) anzeigt, die nur mit dem Datum
welches in der Textbox eintragen wurde . Ich bekomme in der Anzeige aber alle Einträge
Kann mir jemand helfen ?  Danke

Meine Formel ist :

Private Sub UserForm_Initialize()

Dim iZeile As Long
Dim AnzArr As Long
'**** Listbox 2 Anzeige der Termine

ListBox2.ColumnCount = 1
With Worksheets("Datenkal1")
    ' Länge Array bestimmen
    For iZeile = 2 To .Range("Y65536").End(xlUp).Row
        If .Cells(iZeile, 1) > 0 Then AnzArr = AnzArr + 1
    Next iZeile
    
    ' Array dimensionieren
    ReDim Arr(AnzArr, 1)
    
    ' Variable zurücksetzen (Recycling) Smile
    AnzArr = 0
    
    ' Array abfüllen
    For iZeile = 2 To .Range("y65536").End(xlUp).Row
               If .Cells(iZeile, 1) > 0 Then                    
               Arr(AnzArr, 0) = .Cells(iZeile, 1)             
               Arr(AnzArr, 0) = .Cells(iZeile, 25)
            AnzArr = AnzArr + 1
        End If
    Next iZeile
    
    ' Array an Listbox übergeben
    ListBox2.List = Arr
    
End With

***************************************************************
Das ist der Spalteninhalt:
00.01.00----
07.12.17-H.Storch---
00.01.00----
00.01.00----
08.12.17-Mayer---
00.01.00----
00.01.00----
07.12.17-Kahnt---
00.01.00----
00.01.00----
02.01.18-Lewandowski---
00.01.00----
Antworten Top
#2
Hallo

das hier

AnzArr = AnzArr + 1

gehört hinter das End If

ansonsten Beispieldatei


MfG Tom
Antworten Top
#3
Servus excelri,

muss Tom leider korrigieren, die von Tom beschriebene Änderung solltest Du nicht umsetzen.

Wenn Du gegen den Inhalt der Textbox vergleichen willst, dann korrigiere mal folgende zwei Zeilen ...

Code:
If .Cells(iZeile, 1).Text = Textbox6.Value Then AnzArr = AnzArr + 1

...

Code:
If .Cells(iZeile, 1).Text = Textbox6.Value Then

Die Zeile ...

Code:
Arr(AnzArr, 0) = .Cells(iZeile, 1)

macht keinen Sinn, diese kannst Du löschen!

LG Gerd
Antworten Top
#4
Hallo Gerd,  ich habe noch ein Problem .
Nach dem ich das Datum in der Textbox eintragen habe soll sich die Listbox füllen .
Wie und wo muss man das dann eintragen ?

Danke Werner
Antworten Top
#5
Servus Werner,

willst Du hierfür das Ereignis beim Verlassen der TextBox nutzen?

Code:
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)

End Sub
LG Gerd
Antworten Top
#6
(04.12.2017, 12:28)Bamberg schrieb: willst Du hierfür das Ereignis beim Verlassen der TextBox nutzen?

Hi Gerd , es funktioniert nicht . Es dauert lande und es steht nichts darin.  Irgendetwas mache ich falsch. ich habe den Gesamten Code in die Textbox6 eingefügt.

Hier nochmal der Code , vielleicht kann nochmal jemand darüber schauen.  Danke

Code:
Private Sub TextBox6_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim iZeile As Long
Dim AnzArr As Long
'**** Listbox 2 Anzeige der Termine

ListBox2.ColumnCount = 1
With Worksheets("Datenkal1")
        For iZeile = 2 To .Range("Y65536").End(xlUp).Row
                If .Cells(iZeile, 1).Text = TextBox6.Value Then AnzArr = AnzArr + 1
    Next iZeile
    
    ' Array dimensionieren
    ReDim Arr(AnzArr, 1)
    
    ' Variable zurücksetzen (Recycling) :-)
    AnzArr = 0
    
    ' Array abfüllen
    For iZeile = 2 To .Range("y65536").End(xlUp).Row
               If .Cells(iZeile, 1).Text = TextBox6.Value Then
               Arr(AnzArr, 0) = .Cells(iZeile, 25)
            AnzArr = AnzArr + 1
        End If
    Next iZeile
    
    ' Array an Listbox übergeben
    ListBox2.List = Arr
    
End With
End Sub
Antworten Top
#7
Servus Werner,

nach meinen Tests funktioniert der Code einwandfrei.
Hast Du evtl. Deine Spalten auf dem Arbeitsblatt "Datenkal1" verschoben?

Spalte A: Datum
Spalte Y: Werte

LG Gerd
Antworten Top
#8
(05.12.2017, 15:47)Bamberg schrieb: nach meinen Tests funktioniert der Code einwandfrei.
Hast Du evtl. Deine Spalten auf dem Arbeitsblatt "Datenkal1" verschoben?

Hallo Gerd, danke für die Antwort .
Irgendwo ist bei mir ein Denkfehler .. Huh
Ich habe in Spalte A kein Datum  , das Datum was gesucht werden  soll steht in Spalte Y :   Bsp.    07.12.17-Kahnt--- oder    00.01.00----
Jetzt gebe ich in der Textbox6  das Datum ein , beim verlassen der Textbox soll sich die Listbox2  mit den Werten aus der Spalte Y
füllen wenn welche mit dem Datum Bsp. 7.12.17  da sind , ansonsten bleibt die Listbox leer.
Ich will damit verhindern das ein MA doppelt eplant wird.

Grüße Werner
Antworten Top
#9
Servus Werner,

entschuldige bitte, ich hatte mich zu sehr auf Dein VBA Script konzentriert und Dein eigentliches Vorhaben etwas aus den Augen verloren^^

Ersetze mal den Code komplett durch diesen hier:

Code:
Private Sub TextBox6_Exit(ByVal Cancel As MSForms.ReturnBoolean)

   Dim i As Long
   Dim Arr As Variant
   Dim l As Long
   
   With Worksheets("Datenkal1")
       l = .Range("Y65536").End(xlUp).Row
       For i = 2 To l
           If InStr(.Cells(i, "Y").Text, TextBox6.Value) <> 0 Then
               If IsArray(Arr) Then
                   ReDim Preserve Arr(1 To UBound(Arr) + 1)
               Else
                   ReDim Arr(1 To 1)
               End If
               Arr(UBound(Arr)) = .Cells(i, "Y")
           End If
       Next i
   
       ' Array an Listbox übergeben
       If IsArray(Arr) Then
           ListBox2.ColumnCount = 1
           ListBox2.List = Arr
       Else
           ListBox2.Clear
       End If
   
   End With
   
End Sub
LG Gerd
Antworten Top
#10
Hallo Gerd, danke für die Antwort. Du brauchst dich doch nicht Entschuldigen, ich hatte es auch vorher ein bisschen komisch formuliert.

Es funktioniert super, danke   nochmals  :18: . Zum füllen der Listbox benötigt er zwar ein paar Sekunden, aber toll.

Viel Grüße Werner
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste