Listbox einlesen mit TextBox durchsuchen
24.03.2020 07:24:11
Reto
Ich versuche erfolglos ein nachgebautes Formular (das funktioniert soweit einwandfrei) weiter zu optimieren. Als absoluter Anfänger komme ich aber zu keinem brauchbaren Ergebnis.
- Beim Einlesen der ListBox erhalte ich bei den Zahlenwerten anstelle eines Punktes ein Komma. In der ListBox ist es nicht so wichtig, aber bei der Ausgabe in die Textbox.
- Beim "Durchsuchen" der ListBox wollte ich einbauen, dass ich auch nur nach einem Teilstring suchen kann
- Beim "Durchsuchen" der ListBox sollte Gross- und Kleischreibung keine Rolle spielen.
Dieses Forum ist wirklich super. Danke schon mal, falls sich jemand an meinem Problem versuchen wird.
Grüsse Reto
Code:
.
.
.
Private Sub UserForm_Initialize()
'Werte beim Aufrufen des Formulars eintragen. Formular intialisieren
Dim rngHaben As Range
Dim rngSoll As Range
Dim rngKSDritte As Range
With Me
.txtDatum.Value = Date
'.cboKontenDropdown.List = Range("KontenListe").Value
End With
' For Each rngHaben In Range("Konto")
For Each rngHaben In Worksheets("Kontenliste").Range("A1:A121") ' Bis Zelle "A121" _
Zellen mit Fehler #NV verursachen eine Fehlermeldung im VBA. Muss noch korrigiert werden.
With Me.cboHaben
.AddItem rngHaben.Value
'Jede Zelle im Bereich Kategorien wird nach und nach über addItem....
.List(.ListCount - 1, 1) = rngHaben.Offset(0, 1).Value
'Gleichzeitig im Eigenschaftsfenster drauf achten, dass dieser...
End With
Next rngHaben
'Schleife wird so lange durchlaufen wie es Zellen im Bereich Kategorien gibt...
' For Each rngHaben In Range("Konto")
For Each rngSoll In Worksheets("Kontenliste").Range("A1:A121") ' Bis Zelle " _
A121" Zellen mit Fehler #NV verursachen eine Fehlermeldung im VBA. Muss noch korrigiert werden.
With Me.cboSoll
.AddItem rngSoll.Value
'Jede Zelle im Bereich Kategorien wird nach und nach über addItem....
.List(.ListCount - 1, 1) = rngSoll.Offset(0, 1).Value
'Gleichzeitig im Eigenschaftsfenster drauf achten, dass dieser...
End With
Next rngSoll
'Schleife wird so lange durchlaufen wie es Zellen im Bereich Kategorien gibt...
' For Each rngKSDritte In Range("Konto")
For Each rngKSDritte In Worksheets("Kontenliste").Range("F1:F121") _
_
_
' Bis Zelle "A121" Zellen mit Fehler #NV verursachen eine Fehlermeldung im VBA. Muss noch _
_
korrigiert werden.
With Me.cboKSDritte
.AddItem rngKSDritte.Value
'Jede Zelle im Bereich Kategorien wird nach und nach über _
addItem....
.List(.ListCount - 1, 1) = rngKSDritte.Offset(0, 1).Value
'Gleichzeitig im Eigenschaftsfenster drauf achten, dass dieser. _
_
_
End With
Next rngKSDritte
'Schleife wird so lange durchlaufen wie es Zellen im Bereich _
Kategorien gibt...
'Listbox mit allen Daten aus der Liste füllen
Dim lngZeile As Long
Dim lngZeileMax As Long
Dim lngz As Long
With Me.ListBox1
.ColumnCount = 5
.ColumnWidths = "450;50;50;100;100"
.Font.Size = 10
End With
With Tabelle2
lngZeileMax = .Range("E" & .Rows.Count).End(xlUp).Row
For lngZeile = 18 To lngZeileMax
Me.ListBox1.AddItem .Range("G" & lngZeile).Value
Me.ListBox1.Column(1, lngz) = .Range("H" & lngZeile).Value
Me.ListBox1.Column(2, lngz) = .Range("I" & lngZeile).Value
Me.ListBox1.Column(3, lngz) = .Range("J" & lngZeile).Value
Me.ListBox1.Column(4, lngz) = .Range("K" & lngZeile).Value
lngz = lngz + 1
Next lngZeile
End With
Me.txtSuche.Font.Size = 10
End Sub
Private Sub txtSuche_Change()
'Nicht benötigte Zeilen aus der ListBox entfernen
Dim i As Integer
Dim lngLaenge As Long
Dim strText As String
Me.ListBox1.Clear
UserForm_Initialize
lngLaenge = Len(Me.txtSuche.Value)
If Left(Me.txtSuche.Value, 1) = "*" Then
strText = LCase(Replace(Me.txtSuche.Value, "*", ""))
For i = Me.ListBox1.ListCount - 1 To 0 Step -1
If InStr(Me.ListBox1.List(i, 0), strText) > 0 Or _
InStr(Me.ListBox1.List(i, 1), strText) > 0 Or _
InStr(LCase(Me.ListBox1.List(i, 2)), strText) > 0 Then
Else
Me.ListBox1.RemoveItem i
End If
Next i
Else
For i = Me.ListBox1.ListCount - 1 To 0 Step -1
If Left(Me.ListBox1.List(i, 0), lngLaenge) = Me.txtSuche.Value Or _
Left(Me.ListBox1.List(i, 1), lngLaenge) = Me.txtSuche.Value Or _
LCase(Left(Me.ListBox1.List(i, 2), lngLaenge)) = LCase(Me.txtSuche.Value) Then
Else
Me.ListBox1.RemoveItem i
End If
Next i
End If
End Sub
Private Sub Listbox1_Click()
Me.txtBeschreibung.Value = Me.ListBox1.Column(0, Me.ListBox1.ListIndex)
Me.cboSoll = Me.ListBox1.Column(1, Me.ListBox1.ListIndex)
Me.cboHaben = Me.ListBox1.Column(2, Me.ListBox1.ListIndex)
Me.txtBetrag.Value = Me.ListBox1.Column(3, Me.ListBox1.ListIndex)
Me.cboKSDritte = Me.ListBox1.Column(4, Me.ListBox1.ListIndex)
' ActiveCell.Offset(0, 3).Value = CCur(.txtBetrag) 'Ändert den Wert von , auf . (Währung)
End Sub