Hallo Hary,
Danke zunächst für deinen Ansatz, aber ich bekomme es einfach nicht
hin! Hab hier noch einmal den vollständigen Code.
Könntst du oder ein anderes Forumsmitglied diesen entsprechend
anpassen, so das er ab Zeile 200 läuft?
Vielen Dank
Grüße
Anett
Option Explicit
Dim rngFind As Range
Dim rngID As Range
Private Sub CommandButton3_Click()
Dim letzte_Zeile As Long
With Worksheets("Service")
' Datensatz neu speichern
letzte_Zeile = .Range("A65536").End(xlUp).Offset(1, 0).Row
.Cells(letzte_Zeile, 1) = .Cells(letzte_Zeile - 1, 1) + 1
.Cells(letzte_Zeile, 2) = TextBox1.Text
.Cells(letzte_Zeile, 3) = ComboBox1.Text
.Cells(letzte_Zeile, 4) = TextBox2
.Cells(letzte_Zeile, 5) = TextBox3.Text
.Cells(letzte_Zeile, 6) = TextBox4.Text
.Cells(letzte_Zeile, 7) = TextBox5.Text
.Cells(letzte_Zeile, 8) = TextBox6.Text
.Cells(letzte_Zeile, 13) = TextBox7.Text
End With
ClearAll
UserForm_Initialize
ComboBox1.SetFocus
End Sub
Private Sub CommandButton5_Click()
If ComboBox1.Text = "" Then
'UserForm schließen
Unload UserForm1
Exit Sub
Else
If MsgBox("Den angezeigten Datensatz speichern ?", 36, "Sicherheitsabfrage") = vbYes Then
CommandButton3_Click
End If
Unload UserForm1
End If
End Sub
Private Sub CommandButton2_Click()
' Datensatz ändern
rngFind.Value = ComboBox1.Text
rngFind.Offset(0, -1).Value = TextBox1.Text
rngFind.Offset(0, 1).Value = TextBox2.Text
rngFind.Offset(0, 2).Value = TextBox3.Text
rngFind.Offset(0, 3).Value = TextBox4.Text
rngFind.Offset(0, 4).Value = TextBox5.Text
rngFind.Offset(0, 5).Value = TextBox6.Text
rngFind.Offset(0, 10).Value = TextBox7.Text
ClearAll
UserForm_Initialize
ComboBox1.SetFocus
End Sub
Private Sub CommandButton4_Click()
Dim a As Integer
Dim msg
'Datensatz löschen
a = Range(rngFind.Address).Row
If MsgBox(" Datensatz wirklich löschen ?", vbYesNo) = vbNo Then
Exit Sub
Else
Rows(a).Delete
End If
ClearAll
UserForm_Initialize
ComboBox1.SetFocus
End Sub
Private Sub CommandButton1_Click()
Dim sSearch As String
Dim firstAddress
Dim i As Integer
'Datensatz suchen
If ComboBox1.Text = "" Then
MsgBox "Geben Sie bitte einen Suchbegriff ein !"
Exit Sub
Else
sSearch = ComboBox1.Text
Set rngFind = Columns("C:C").Find(what:=sSearch, lookat:=xlWhole, LookIn:=xlValues)
If rngFind Is Nothing Then
If MsgBox("Dieser Datensatz existiert noch nicht !" & vbCrLf & vbCrLf & " Möchten Sie ihn _
jetzt neu anlegen ?", vbQuestion + vbYesNo, "Nachfragen") = vbNo Then
ComboBox1.Text = ""
ComboBox1.SetFocus
Exit Sub
Else
ComboBox1.SetFocus
End If
Else
i = 0
firstAddress = rngFind.Address
Do
ListBox1.AddItem
ListBox1.List(i, 0) = rngFind.Offset(0, -2).Value
ListBox1.List(i, 1) = rngFind.Offset(0, -1).Value
ListBox1.List(i, 2) = rngFind
ListBox1.List(i, 3) = rngFind.Offset(0, 1).Value
ListBox1.List(i, 4) = rngFind.Offset(0, 2).Value
ListBox1.List(i, 5) = rngFind.Offset(0, 3).Value
ListBox1.List(i, 6) = rngFind.Offset(0, 4).Value
Set rngFind = Columns("C:C").FindNext(rngFind)
i = i + 1
Loop While Not rngFind Is Nothing And rngFind.Address firstAddress
End If
End If
If ListBox1.ListCount = 1 Then
TextBox1.Text = rngFind.Offset(0, -1).Value
TextBox2.Text = rngFind.Offset(0, 1).Value
TextBox3.Text = rngFind.Offset(0, 2).Value
TextBox4.Text = rngFind.Offset(0, 3).Value
TextBox5.Text = rngFind.Offset(0, 4).Value
TextBox6.Text = rngFind.Offset(0, 5).Value
TextBox7.Text = rngFind.Offset(0, 10).Value
ListBox1.Clear
End If
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim sSearch As String
If ListBox1.ListCount > 1 Then
sSearch = ListBox1.List(ListBox1.ListIndex, 0)
Set rngID = Columns("A:A").Find(what:=sSearch, lookat:=xlWhole, LookIn:=xlValues)
If Not rngID Is Nothing Then
TextBox1.Text = rngID.Offset(0, 1).Value
TextBox2.Text = rngID.Offset(0, 3).Value
TextBox3.Text = rngID.Offset(0, 4).Value
TextBox4.Text = rngID.Offset(0, 5).Value
TextBox5.Text = rngID.Offset(0, 6).Value
TextBox6.Text = rngID.Offset(0, 7).Value
TextBox7.Text = rngID.Offset(0, 12).Value
End If
sSearch = ""
End If
ListBox1.Clear
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'Fehlermeldung, wenn versucht wird, die UserForm über das
'Schließenkreuz oben rechts zu schließen
If CloseMode = 0 Then
Cancel = 1
MsgBox "Bitte verlassen Sie die Eingabemaske nur mit der Schaltfläche - Beenden.", _
vbOKOnly + vbInformation, "Bitte Schaltfläche betätigen."
End If
End Sub
Public Sub UserForm_Initialize()
Dim a As Integer
a = Sheets("Service").Range("A65536").End(xlUp).Row
ComboBox1.RowSource = "Service!C2:C" & a
End Sub
Sub ClearAll()
Dim C As Integer
On Error Resume Next
For C = 1 To 2
Me.Controls("ComboBox" & CStr(C)).Text = ""
Next C
For C = 1 To 7
Me.Controls("TextBox" & CStr(C)).Text = ""
Next C
End Sub