Zeitfor Listbox mit Suchfunktion
07.12.2021 13:57:34
Mila
ich bin schon verzweifelt , wer kann mir bitte halfen ? Nach einer Woche Arbeit habe ich mir einen Programm für die Kunden erfassung für das eigenes Testzentrum gebastellt .Datenerfassung in die Tabelle1 mitten UserForm1 mit 3 Comboboxen und Mehreren TextBoxen funktioniert prima, einige Textboxen habe ich gelöscht deshalb solche Bezeichnungen , mit dem code :
Private Sub CommandButton2_Click()
Dim WkSh As Worksheet
Dim lZeile As Long
Dim oControl As Control
Dim iMax As Integer
Dim iLfdNr As Integer
Set WkSh = ThisWorkbook.Worksheets("Tabelle1")
lZeile = WkSh.Cells(Rows.Count, 2).End(xlUp).Row + 1
WkSh.Cells(lZeile, 2).Value = Me.TextBox1.Value ' Ausweiss/Pass-Nummer
WkSh.Cells(lZeile, 3).Value = Me.TextBox15.Value ' Testdatum
WkSh.Cells(lZeile, 4).Value = Me.ComboBox2.Value ' Anrede
WkSh.Cells(lZeile, 5).Value = Me.TextBox17.Value ' Vorname
WkSh.Cells(lZeile, 6).Value = Me.TextBox18.Value ' Nachname
WkSh.Cells(lZeile, 7).Value = Me.TextBox4.Value ' Strasse/Nr.
WkSh.Cells(lZeile, 8).Value = Me.TextBox8.Value ' PLZ
WkSh.Cells(lZeile, 9).Value = Me.TextBox7.Value ' Ort
WkSh.Cells(lZeile, 10).Value = Time ' Testzeit
WkSh.Cells(lZeile, 11).Value = Me.TextBox6.Value 'Geburtsdatum
WkSh.Cells(lZeile, 12).Value = Me.TextBox19.Value ' Testergebnis positiv
WkSh.Cells(lZeile, 13).Value = Me.TextBox20.Value ' Testergebnis negativ
WkSh.Cells(lZeile, 14).Value = Me.ComboBox1.Value 'Tester
WkSh.Cells(lZeile, 15).Value = Me.ComboBox6.Value ' Testname
WkSh.Cells(lZeile, 16).Value = Me.ComboBox8.Value ' Hersteller
WkSh.Cells(lZeile, 17).Value = Me.TextBox21.Value ' e-mail
iLfdNr = 0
lZeile = 4
Do
iMax = Val(WkSh.Cells(lZeile, 1).Value)
If iMax > iLfdNr Then iLfdNr = iMax
lZeile = lZeile + 1
Loop Until Trim(WkSh.Cells(lZeile, 1).Value) = ""
With WkSh.Cells(lZeile, 1)
.NumberFormat = "@"
.Value = (iLfdNr + 1) & "."
End With
For Each oControl In Me.Controls
If InStr(1, oControl.Name, "Text") > 0 Then oControl.Value = ""
Next oControl
Set oControl = Nothing
Me.TextBox15 = Date
Me.TextBox16 = Time
' Blendet eine Msgbox nach 1 Sekunde automatisch wieder aus
' Verweis auf Microsoft Scripting Runtime
Dim WsShell
Dim intText As Integer
Set WsShell = CreateObject("WScript.Shell")
intText = WsShell.Popup("Bestellung erfasst", 1)
' Die 1 in der letzten Zeile gibt die Dauer der Öffnung an.
End Sub
-in der Spalte E sind alle Vornamen eingetragen und die Suchfunktion findet die Vornamen einwandfrei , aber das Ergebnis in der Listbox fängt dann mit dem Vornamen anstatt mit dem einträgen aus dem Spaltem B,C,D . Ganz schlimm ist die Zeitangabe wo eine Dezimalzahl steht anstatt der Richtige Eintrag aus der Tabelle1.
code:
' Eingabe in die Such-TextBox erfolgt
Private Sub txtSearch_Change()
Dim rRng As Range
Dim iAnzahl As Integer
Dim vTemp(0 To 5000, 0 To 16) As Variant
Dim iIndx As Integer
With Userform1.ListBox1
.Clear
.ColumnCount = 16
.ColumnWidths = ("2,9cm;1,8cm;1,3cm;3,9cm;4,5cm;3,5cm;1,2cm;" & _
"3,5cm;1,8cm;2,3cm;2cm;2cm;1,8cm;2,2cm;1,4cm;" & _
"0cm") ' die 0cm-Spalte ist unsichtbar
.ListStyle = fmListStyleOption
End With
For Each rRng In Worksheets("Tabelle1").Range("E5:E5000").Cells
If UCase(rRng.Text) Like "*" & UCase(Trim(txtSearch.Text)) & "*" Then
For iIndx = 0 To 15
vTemp(iAnzahl, iIndx) = rRng.Offset(0, iIndx)
Next iIndx
vTemp(iAnzahl, 16) = rRng.Row ' die Zeile der gespeicherten Datensätze festhalten
iAnzahl = iAnzahl + 1
End If
Next rRng
Userform1.ListBox1.List() = vTemp
End Sub
code:
Private Sub ListBox1_DblClick(ByVal cancel As MSForms.ReturnBoolean)
Me.TextBox1.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 0) 'Ausweis/Passnummer
Me.TextBox15.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 1) 'Testdatum
Me.ComboBox2.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 2) 'Anrede
Me.TextBox17.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 3) 'Vorname
Me.TextBox18.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 4) 'Nachname
Me.TextBox4.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 5) 'Strasse/Nummer
Me.TextBox8.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 6) 'PLZ
Me.TextBox7.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 7) 'Ort
Me.TextBox16.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 8) 'Testzeit
Me.TextBox6.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 9) 'Geburtsdatum
Me.TextBox19.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 10) 'Testergebnis poitiv
Me.TextBox20.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 11) 'Testergebnis negativ
Me.ComboBox1.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 12) 'Tester
Me.ComboBox6.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 13) 'Name des Tests
Me.ComboBox8.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 14) 'Hersteller
Me.TextBox21.Value = Me.ListBox1.List(Me.ListBox1.ListIndex, 15) 'e-mail
lZeile = Me.ListBox1.List(Me.ListBox1.ListIndex, 16) ' die Zeile speichern
CommandButton3.Enabled = True ' Commanbutton freigeben
CommandButton4.Enabled = True ' Commanbutton freigeben
End Sub
Vielen herzlichen Dank im Voraus.