daten ändern

Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then
Suchart = xlWhole
Else
Suchart = xlPart
End If
End Sub

Private Sub CheckBox2_Click()
If CheckBox2.Value = True Then
ComboBox1.Enabled = False
Else
ComboBox1.Enabled = True
End If
End Sub

Private Sub CommandButton1_Click()
Dim xSuche, xAdresse, xErste As String
Dim y As Boolean
Dim arr() As Variant
Dim rng As Range
Dim iCounter, iRowU As Integer
ListBox1.Clear
xSuche = TextBox1.Value
If xSuche = "" Then
MsgBox "Bitte erst einen Suchbegriff eingeben!", vbExclamation, "Achtung!"
Exit Sub
End If
If ComboBox1.Value = "" And CheckBox2.Value = False Then
MsgBox "Bitte geben Sie ein, wo der Begriff gesucht werden soll!", vbExclamation, "Achtung!" _
Exit Sub
End If
For iCounter = 1 To ThisWorkbook.Sheets.Count
If CheckBox2.Value = True Or Worksheets(iCounter).Name = ComboBox1.Value Then
Set rng = Worksheets(iCounter).Cells.Find _
(xSuche, lookat:=Suchart, LookIn:=xlValues)
If Not rng Is Nothing Then
With Worksheets(iCounter)
xErste = rng.Address(False, False)
y = True
Do Until xAdresse = xErste
ReDim Preserve arr(0 To 6, 0 To iRowU)
arr(0, iRowU) = .Name
arr(1, iRowU) = rng.Address(False, False)
arr(2, iRowU) = .Cells(rng.Row, 1)
arr(3, iRowU) = .Cells(rng.Row, 2)
arr(4, iRowU) = .Cells(rng.Row, 3)
arr(5, iRowU) = .Cells(rng.Row, 4)
arr(6, iRowU) = .Cells(rng.Row, 5)
iRowU = iRowU + 1
Set rng = .Cells.FindNext(after:=rng)
xAdresse = rng.Address(False, False)
Loop
xAdresse = ""
xErste = ""
End With
End If
End If
Next iCounter
If y = False Then
MsgBox "Der Suchbegriff wurde nicht gefunden!"
Else
ListBox1.Column = arr
End If
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub CommandButton3_Click()
Dim iCounter, xCounter As Long
Set wkb1 = ThisWorkbook
Set wkb2 = Workbooks.Add(1)
Set wks2 = wkb2.Sheets(1)
wkb1.Activate
For iCounter = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(iCounter) And xOpt = 1 Or xOpt = 2 Then
Set XBlatt = Sheets(ListBox1.List(iCounter, 0))
XZeile = Range(ListBox1.List(iCounter, 1)).Row
xCounter = xCounter + 1
XBlatt.Rows(XZeile).Copy wks2.Rows(xCounter)
End If
Next iCounter
wks2.Activate
End Sub

Private Sub CommandButton4_Click()
Dim iCounter, xCounter As Long
Set wkb1 = ThisWorkbook
Set wkb2 = Workbooks.Add(1)
Set wks2 = wkb2.Sheets(1)
wkb1.Activate
For iCounter = ListBox1.ListCount - 1 To 0 Step -1
If ListBox1.Selected(iCounter) And xOpt = 1 Or xOpt = 2 Then
Set XBlatt = Sheets(ListBox1.List(iCounter, 0))
XZeile = Range(ListBox1.List(iCounter, 1)).Row
xCounter = xCounter + 1
XBlatt.Rows(XZeile).Copy wks2.Rows(xCounter)
XBlatt.Rows(XZeile).Delete Shift:=xlUp
ListBox1.RemoveItem (iCounter)
End If
Next iCounter
wks2.Activate
End Sub

Private Sub CommandButton5_Click()
Dim iCounter As Long
If MsgBox("Die markierten Daten werden unwideruflich aus dieser Datei gelöscht." & vbLf & _
"Wollen Sie fortfahren?", vbOKCancel, "Achtung!") = vbOK Then
For iCounter = ListBox1.ListCount - 1 To 0 Step -1
If ListBox1.Selected(iCounter) And xOpt = 1 Or xOpt = 2 Then
Set XBlatt = Sheets(ListBox1.List(iCounter, 0))
XZeile = Range(ListBox1.List(iCounter, 1)).Row
XBlatt.Rows(XZeile).Delete Shift:=xlUp
ListBox1.RemoveItem (iCounter)
End If
Next iCounter
End If
End Sub

Private Sub CommandButton6_Click()
With ListBox1
UserForm1.TextBox2 = .List(.ListIndex, 0)
UserForm1.TextBox3 = .List(.ListIndex, 1)
UserForm1.TextBox4 = .List(.ListIndex, 2)
UserForm1.TextBox5 = .List(.ListIndex, 3)
UserForm1.TextBox6 = .List(.ListIndex, 4)
'...etc
End With
End Sub

Private Sub CommandButton7_Click()
Dim rng As Range
Dim sSearch As String
Dim intCounter As Integer
Dim mldg
Dim Stil
Dim titel
Dim ergebnis
Dim xSuche
Set rng = Worksheets(iCounter).Cells.Find _
(xSuche, lookat:=Suchart, LookIn:=xlValues)
rng.Offset(0, 3).Value = TextBox3.Text
rng.Offset(0, 4).Value = TextBox4.Text
rng.Offset(0, 5).Value = TextBox5.Text
rng.Offset(0, 6).Value = TextBox6.Text
rng.Offset(0, 7).Value = TextBox7.Text
rng.Offset(0, 8).Value = TextBox8.Text
'rng.Offset(0, 9).Value = TextBox9.Text
'sSearch = ListBox1.Text
'If sSearch = "" Then Exit Sub
'If sSearch = "Kd-Nr" Then
'mldg = "Es wurde kein Kunde aus der Liste angewählt oder" _
'& " neu angelegt." & Chr(10) & Chr(10) _
'& "Es kann keine Datenübernahme vorgenommen werden."
'Stil = vbOKOnly + vbInformation
'titel = "Dateneingabekontrolle"
'ergebnis = MsgBox(mldg, Stil, titel)
'Exit Sub
'End If
'Set rng = ActiveSheet.Columns("A:A").Find(
'what:=sSearch, LookIn:=xlValues, lookat:=xlWhole, _
'searchorder:=xlByRows)
'If rng Is Nothing Then
'Exit Sub
'End If
'For intCounter = 1 To 51
'Cells(rng.Row, intCounter + 3).Value = Controls("TextBox" & intCounter).Text
'Next
'mldg = "Die Eintragungen wurden in die Datenbank übernommen."
'Stil = vbOKOnly + vbInformation
'titel = "Dateneingabe - Übernahme - Bestätigung"
'ergebnis = MsgBox(mldg, Stil, titel)
'With ListBox1
'If .Enabled Then
' Hinzufügen!
' .AddItem TextBox5.Text
'Else
' Aktualisieren
'.List(.ListIndex) = TextBox5.Text
' .Enabled = True
' End If
'TextBox5.Text = ""
'End With
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Application.Goto Sheets(ListBox1.List(ListBox1.ListIndex, 0)).Range(ListBox1.List(ListBox1. _
ListIndex, 1))
End Sub

Private Sub OptionButton1_Click()
xOpt = 1
End Sub

Private Sub OptionButton2_Click()
xOpt = 2
End Sub

Private Sub UserForm_Initialize()
For Each wks In Worksheets
If wks.Name  ActiveSheet.Name Then ComboBox1.AddItem wks.Name
Next
Suchart = xlPart
xOpt = 1
End Sub