Ich habe mir, Dank dieses super Forums, insbesondere Beni´s Hilfe, ein Eingabeformular erstellt, mit dem ich Besucher einer Veranstaltung registrieren und deren Daten Suchen, Speichern, Verändern und Löschen kann.
Nun zu meinem Problem:
In einer Listbox in meinem Formular werden die Daten aus einem Tabellenblatt ("Auswertung") angezeigt.
Jetzt kann ich im Eingabeformular in der Textbox (Firma) Buchstaben eingeben und mit dem Commandbutton "Suchen" werden in der Listbox nur die Firmen die mit diesen Buchstaben anfangen angezeigt. Klicke ich mit der Maus auf einen Eintrag in der Listbox, werden diese Daten in das Formular zurückgeschrieben, damit ich diese neu Eintragen, Ändern oder Löschen kann.
Das Problem ist: Wenn ich einen Eintrag in der Listbox ausgewählt habe wird die Sortierung aufgelöst und es werden wieder alle Daten so wie Diese im Tabellenblatt "Auswertung" stehen angezeigt.
Könnte mir Jemand meinen Code so umschreiben, dass die Sortierung und Anzeige im Listenfeld solange bestehen bleibt bis eine neue Suche gestartet wird. Und vieleicht noch, wenn ich bei der Suche gar keinen Wert in die Textbox Firma eingebe wieder der gesamte Inhalt des Blattes "Auswertung" angezeigt wird.
Nachfolgend habe ich mal den gesamten Code der Userform aufgelistet. Eine Beispielmappe habe ich auch hochgeladen.
Private Sub cbEnde_Click()
Unload Me
End Sub
Private Sub cbAendern_Click()
Dim lz As Integer
Application.ScreenUpdating = False
With Sheets("Auswertung")
Set c = .Columns(1).Find(What:=TextBox1.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then lz = c.Row
.Cells(lz, 2) = TextBox2
.Cells(lz, 3) = ComboBox1
.Cells(lz, 4) = TextBox3
.Cells(lz, 6) = TextBox4
.Cells(lz, 7) = TextBox5
.Cells(lz, 8) = TextBox6
.Cells(lz, 9) = TextBox7
.Cells(lz, 10) = TextBox8
.Cells(lz, 11) = ComboBox2
.Cells(lz, 12) = TextBox9
.Cells(lz, 13) = TextBox10
.Cells(lz, 14) = TextBox11
.Cells(lz, 5) = TextBox12
If OptionButton1.Value = True Then .Cells(lz, 15) = 1 Else .Cells(lz, 15) = ""
If OptionButton2.Value = True Then .Cells(lz, 16) = 1 Else .Cells(lz, 16) = ""
If CheckBox1.Value = True Then .Cells(lz, 17) = 1 Else .Cells(lz, 17) = ""
If CheckBox2.Value = True Then .Cells(lz, 18) = 1 Else .Cells(lz, 18) = ""
If CheckBox3.Value = True Then .Cells(lz, 19) = 1 Else .Cells(lz, 19) = ""
If CheckBox4.Value = True Then .Cells(lz, 20) = 1 Else .Cells(lz, 20) = ""
If CheckBox5.Value = True Then .Cells(lz, 21) = 1 Else .Cells(lz, 21) = ""
If CheckBox6.Value = True Then .Cells(lz, 22) = 1 Else .Cells(lz, 22) = ""
If CheckBox7.Value = True Then .Cells(lz, 23) = 1 Else .Cells(lz, 23) = ""
If CheckBox8.Value = True Then .Cells(lz, 24) = 1 Else .Cells(lz, 24) = ""
If CheckBox9.Value = True Then .Cells(lz, 25) = 1 Else .Cells(lz, 25) = ""
If CheckBox10.Value = True Then .Cells(lz, 26) = 1 Else .Cells(lz, 26) = ""
If CheckBox11.Value = True Then .Cells(lz, 27) = 1 Else .Cells(lz, 27) = ""
If CheckBox12.Value = True Then .Cells(lz, 28) = 1 Else .Cells(lz, 28) = ""
If CheckBox13.Value = True Then .Cells(lz, 29) = 1 Else .Cells(lz, 29) = ""
If CheckBox14.Value = True Then .Cells(lz, 30) = 1 Else .Cells(lz, 30) = ""
If CheckBox15.Value = True Then .Cells(lz, 31) = 1 Else .Cells(lz, 31) = ""
If CheckBox16.Value = True Then .Cells(lz, 32) = 1 Else .Cells(lz, 32) = ""
End With
Application.ScreenUpdating = True
End Sub
Private Sub cbHinzufügen_Click()
Dim lz As Integer
Application.ScreenUpdating = False
With Sheets("Auswertung")
lz = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(lz, 1) = WorksheetFunction.Max(Range(.Cells(5, 1), .Cells(lz, 1))) + 1
.Cells(lz, 2) = TextBox2
.Cells(lz, 3) = ComboBox1
.Cells(lz, 4) = TextBox3
.Cells(lz, 6) = TextBox4
.Cells(lz, 7) = TextBox5
.Cells(lz, 8) = TextBox6
.Cells(lz, 9) = TextBox7
.Cells(lz, 10) = TextBox8
.Cells(lz, 11) = ComboBox2
.Cells(lz, 12) = TextBox9
.Cells(lz, 13) = TextBox10
.Cells(lz, 14) = TextBox11
.Cells(lz, 5) = TextBox12
If OptionButton1.Value = True Then .Cells(lz, 15) = 1
If OptionButton2.Value = True Then .Cells(lz, 16) = 1
If CheckBox1.Value = True Then .Cells(lz, 17) = 1
If CheckBox2.Value = True Then .Cells(lz, 18) = 1
If CheckBox3.Value = True Then .Cells(lz, 19) = 1
If CheckBox4.Value = True Then .Cells(lz, 20) = 1
If CheckBox5.Value = True Then .Cells(lz, 21) = 1
If CheckBox6.Value = True Then .Cells(lz, 22) = 1
If CheckBox7.Value = True Then .Cells(lz, 23) = 1
If CheckBox8.Value = True Then .Cells(lz, 24) = 1
If CheckBox9.Value = True Then .Cells(lz, 25) = 1
If CheckBox10.Value = True Then .Cells(lz, 26) = 1
If CheckBox11.Value = True Then .Cells(lz, 27) = 1
If CheckBox12.Value = True Then .Cells(lz, 28) = 1
If CheckBox13.Value = True Then .Cells(lz, 29) = 1
If CheckBox14.Value = True Then .Cells(lz, 30) = 1
If CheckBox15.Value = True Then .Cells(lz, 31) = 1
If CheckBox16.Value = True Then .Cells(lz, 32) = 1
lz = .Cells(Rows.Count, 1).End(xlUp).Row
ListBox1.RowSource = "Auswertung!a5:af" & lz
Dim Ob As MSForms.Control
For Each Ob In UserForm1.Controls
If TypeOf Ob Is MSForms.TextBox Then Ob.Value = ""
If TypeOf Ob Is MSForms.ComboBox Then Ob.Value = ""
If TypeOf Ob Is MSForms.CheckBox Then Ob.Value = False
Next Ob
End With
Application.ScreenUpdating = True
End Sub
Private Sub cbLöschen_Click()
Dim Mldg, Stil, Titel, Antwort
Mldg = "Datensatz löschen ?"
Stil = vbYesNo + vbCritical + vbDefaultButton2
Titel = "Datensatz löschen"
Antwort = MsgBox(Mldg, Stil, Titel)
If Antwort = vbNo Then Exit Sub
With Sheets("Auswertung")
Set c = .Columns(1).Find(What:=TextBox1.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then .Rows(c.Row).Delete Shift:=xlUp
lz = .Cells(Rows.Count, 1).End(xlUp).Row
ListBox1.RowSource = "Auswertung!a5:af" & lz
Dim Ob As MSForms.Control
For Each Ob In UserForm1.Controls
If TypeOf Ob Is MSForms.TextBox Then Ob.Value = ""
If TypeOf Ob Is MSForms.ComboBox Then Ob.Value = ""
If TypeOf Ob Is MSForms.CheckBox Then Ob.Value = False
Next Ob
End With
End Sub
Private Sub cbSuchen_Click()
Dim z As Integer
If Len(TextBox2) > 0 Then
ListBox2.Visible = True
ListBox2.Clear
ListBox2.Top = ListBox1.Top
ListBox2.Left = ListBox1.Left
ListBox2.Height = ListBox1.Height
ListBox2.Width = ListBox1.Width
With Sheets("Auswertung")
Wert = TextBox2
For r = 2 To .Cells(65536, 2).End(xlUp).Row
Set c = .Cells(r, 2).Find(Wert & "*", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False) _
If Not c Is Nothing Then
ListBox2.AddItem .Cells(r, 1)
z = ListBox2.ListCount - 1
ListBox2.List(z, 1) = .Cells(r, 2)
ListBox2.List(z, 2) = .Cells(r, 4)
ListBox2.List(z, 3) = .Cells(r, 7)
ListBox2.List(z, 4) = .Cells(r, 8)
ListBox2.List(z, 5) = .Cells(r, 9)
ListBox2.List(z, 6) = .Cells(r, 10)
End If
Next r
End With
End If
End Sub
Private Sub ListBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
On Error GoTo e
TextBox1 = ListBox1.List(ListBox1.ListIndex, 0)
TextBox2 = ListBox1.List(ListBox1.ListIndex, 1)
ComboBox1 = ListBox1.List(ListBox1.ListIndex, 2)
TextBox3 = ListBox1.List(ListBox1.ListIndex, 3)
TextBox4 = ListBox1.List(ListBox1.ListIndex, 5)
TextBox5 = ListBox1.List(ListBox1.ListIndex, 6)
TextBox6 = ListBox1.List(ListBox1.ListIndex, 7)
TextBox7 = ListBox1.List(ListBox1.ListIndex, 8)
TextBox8 = ListBox1.List(ListBox1.ListIndex, 9)
ComboBox2 = ListBox1.List(ListBox1.ListIndex, 10)
TextBox9 = ListBox1.List(ListBox1.ListIndex, 11)
TextBox10 = ListBox1.List(ListBox1.ListIndex, 12)
TextBox11 = ListBox1.List(ListBox1.ListIndex, 13)
TextBox12 = ListBox1.List(ListBox1.ListIndex, 4)
If Not ListBox1.List(ListBox1.ListIndex, 14) = "" Then OptionButton1.Value = True
If Not ListBox1.List(ListBox1.ListIndex, 15) = "" Then OptionButton2.Value = True
If Not ListBox1.List(ListBox1.ListIndex, 16) = "" Then CheckBox1.Value = True Else CheckBox1. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 17) = "" Then CheckBox2.Value = True Else CheckBox2. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 18) = "" Then CheckBox3.Value = True Else CheckBox3. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 19) = "" Then CheckBox4.Value = True Else CheckBox4. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 20) = "" Then CheckBox5.Value = True Else CheckBox5. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 21) = "" Then CheckBox6.Value = True Else CheckBox6. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 22) = "" Then CheckBox7.Value = True Else CheckBox7. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 23) = "" Then CheckBox8.Value = True Else CheckBox8. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 24) = "" Then CheckBox9.Value = True Else CheckBox9. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 25) = "" Then CheckBox10.Value = True Else CheckBox10. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 26) = "" Then CheckBox11.Value = True Else CheckBox11. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 27) = "" Then CheckBox12.Value = True Else CheckBox12. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 28) = "" Then CheckBox13.Value = True Else CheckBox13. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 29) = "" Then CheckBox14.Value = True Else CheckBox14. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 30) = "" Then CheckBox15.Value = True Else CheckBox15. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 31) = "" Then CheckBox16.Value = True Else CheckBox16. _
Value = False
e:
End Sub
Private Sub ListBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, _
ByVal Y As Single)
On Error GoTo e
TextBox1 = ListBox1.List(ListBox1.ListIndex, 0)
TextBox2 = ListBox1.List(ListBox1.ListIndex, 1)
ComboBox1 = ListBox1.List(ListBox1.ListIndex, 2)
TextBox3 = ListBox1.List(ListBox1.ListIndex, 3)
TextBox4 = ListBox1.List(ListBox1.ListIndex, 5)
TextBox5 = ListBox1.List(ListBox1.ListIndex, 6)
TextBox6 = ListBox1.List(ListBox1.ListIndex, 7)
TextBox7 = ListBox1.List(ListBox1.ListIndex, 8)
TextBox8 = ListBox1.List(ListBox1.ListIndex, 9)
ComboBox2 = ListBox1.List(ListBox1.ListIndex, 10)
TextBox9 = ListBox1.List(ListBox1.ListIndex, 11)
TextBox10 = ListBox1.List(ListBox1.ListIndex, 12)
TextBox11 = ListBox1.List(ListBox1.ListIndex, 13)
TextBox12 = ListBox1.List(ListBox1.ListIndex, 4)
If Not ListBox1.List(ListBox1.ListIndex, 14) = "" Then OptionButton1.Value = True
If Not ListBox1.List(ListBox1.ListIndex, 15) = "" Then OptionButton2.Value = True
If Not ListBox1.List(ListBox1.ListIndex, 16) = "" Then CheckBox1.Value = True Else CheckBox1. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 17) = "" Then CheckBox2.Value = True Else CheckBox2. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 18) = "" Then CheckBox3.Value = True Else CheckBox3. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 19) = "" Then CheckBox4.Value = True Else CheckBox4. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 20) = "" Then CheckBox5.Value = True Else CheckBox5. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 21) = "" Then CheckBox6.Value = True Else CheckBox6. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 22) = "" Then CheckBox7.Value = True Else CheckBox7. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 23) = "" Then CheckBox8.Value = True Else CheckBox8. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 24) = "" Then CheckBox9.Value = True Else CheckBox9. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 25) = "" Then CheckBox10.Value = True Else CheckBox10. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 26) = "" Then CheckBox11.Value = True Else CheckBox11. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 27) = "" Then CheckBox12.Value = True Else CheckBox12. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 28) = "" Then CheckBox13.Value = True Else CheckBox13. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 29) = "" Then CheckBox14.Value = True Else CheckBox14. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 30) = "" Then CheckBox15.Value = True Else CheckBox15. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 31) = "" Then CheckBox16.Value = True Else CheckBox16. _
Value = False
e:
End Sub
Private Sub ListBox2_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, _
ByVal Y As Single)
If ListBox2.ListCount = 0 Then ListBox2.Visible = False: Exit Sub
If ListBox2.ListIndex = -1 Then Exit Sub
For i = 0 To ListBox1.ListCount - 1
Li = ListBox2.ListIndex
If CStr(ListBox1.List(i, 0)) = CStr(ListBox2.List(ListBox2.ListIndex, 0)) Then
ListBox1.SetFocus
ListBox1.Selected(i) = True
Else
ListBox1.Selected(i) = False
End If
Next i
ListBox2.Visible = False
On Error GoTo e
TextBox1 = ListBox1.List(ListBox1.ListIndex, 0)
TextBox2 = ListBox1.List(ListBox1.ListIndex, 1)
ComboBox1 = ListBox1.List(ListBox1.ListIndex, 2)
TextBox3 = ListBox1.List(ListBox1.ListIndex, 3)
TextBox4 = ListBox1.List(ListBox1.ListIndex, 5)
TextBox5 = ListBox1.List(ListBox1.ListIndex, 6)
TextBox6 = ListBox1.List(ListBox1.ListIndex, 7)
TextBox7 = ListBox1.List(ListBox1.ListIndex, 8)
TextBox8 = ListBox1.List(ListBox1.ListIndex, 9)
ComboBox2 = ListBox1.List(ListBox1.ListIndex, 10)
TextBox9 = ListBox1.List(ListBox1.ListIndex, 11)
TextBox10 = ListBox1.List(ListBox1.ListIndex, 12)
TextBox11 = ListBox1.List(ListBox1.ListIndex, 13)
TextBox12 = ListBox1.List(ListBox1.ListIndex, 4)
If Not ListBox1.List(ListBox1.ListIndex, 14) = "" Then OptionButton1.Value = True
If Not ListBox1.List(ListBox1.ListIndex, 15) = "" Then OptionButton2.Value = True
If Not ListBox1.List(ListBox1.ListIndex, 16) = "" Then CheckBox1.Value = True Else CheckBox1. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 17) = "" Then CheckBox2.Value = True Else CheckBox2. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 18) = "" Then CheckBox3.Value = True Else CheckBox3. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 19) = "" Then CheckBox4.Value = True Else CheckBox4. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 20) = "" Then CheckBox5.Value = True Else CheckBox5. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 21) = "" Then CheckBox6.Value = True Else CheckBox6. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 22) = "" Then CheckBox7.Value = True Else CheckBox7. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 23) = "" Then CheckBox8.Value = True Else CheckBox8. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 24) = "" Then CheckBox9.Value = True Else CheckBox9. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 25) = "" Then CheckBox10.Value = True Else CheckBox10. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 26) = "" Then CheckBox11.Value = True Else CheckBox11. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 27) = "" Then CheckBox12.Value = True Else CheckBox12. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 28) = "" Then CheckBox13.Value = True Else CheckBox13. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 29) = "" Then CheckBox14.Value = True Else CheckBox14. _
Value = False
If Not ListBox1.List(ListBox1.ListIndex, 30) = "" Then CheckBox15.Value = True Else CheckBox15. _
Value = False
e:
End Sub
Private Sub UserForm_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim Ob As MSForms.Control
For Each Ob In UserForm1.Controls
If TypeOf Ob Is MSForms.TextBox Then Ob.Value = ""
If TypeOf Ob Is MSForms.ComboBox Then Ob.Value = ""
If TypeOf Ob Is MSForms.CheckBox Then Ob.Value = False
Next Ob
cbHinzufügen.Caption = "Hinzufügen"
End Sub
Private Sub UserForm_Initialize()
Dim lz As Integer
With ComboBox1
.AddItem "Herr"
.AddItem "Frau"
.AddItem "Herr und Frau"
.AddItem "Monsieur"
.AddItem "Madam"
.AddItem "Signor"
.AddItem "Signora"
.AddItem "Dr."
End With
'Bildschirmanpassung der UserForm
Dim MyControl As Object
For Each MyControl In Controls
MyControl.Top = MyControl.Top * Application.Height / UserForm1.Height
MyControl.Left = MyControl.Left * Application.Width / UserForm1.Width
MyControl.Width = MyControl.Width * Application.Width / UserForm1.Width
MyControl.Height = MyControl.Height * Application.Height / UserForm1.Height
Next
With UserForm1
.Height = Application.Height - 3
.Width = Application.Width - 4
Me.Left = 0
Me.Top = 0
End With
With ComboBox2
.AddItem "Schweiz"
.AddItem "Östereich"
.AddItem "Frankreich"
.AddItem "Deutschland"
End With
ListBox1.ColumnCount = 31
lz = Sheets("Auswertung").Cells(Rows.Count, 1).End(xlUp).Row
ListBox1.RowSource = "Auswertung!a5:af" & lz
End Sub
Die Datei https://www.herber.de/bbs/user/33.xls wurde aus Datenschutzgründen gelöscht
Ich hoffe mir kann Jemand helfen, leider verstehe ich von VBA fast nichts.
Danke im vorraus.
mfg, Andreas