daten ändern

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Bild

Betrifft: daten ändern
von: Thomas
Geschrieben am: 10.11.2015 08:23:41

Hallo Excelfreunde,
ich habe hier eine coole UF gefunden. Diese möchte ich gern ein wenig erweitern.
Ich möchte die gefundenen daten (Zeile) in den textboxen schreiben ( dies habe ich schon geschafft) und dann verändern ( mit CommandButton7 ) und wieder zurückschreiben. Ich habe schon einiges versucht nur es will nicht gelingen.
Kann mir jemand zeigen wie ich das machen könnte? Der Code im CommandButton7
sieht nur durch meine versuche so wüst aus
https://www.herber.de/bbs/user/101365.xls
liebe grüsse thomas
Option Explicit
Dim wks As Worksheet
Dim wkb1, wkb2 As Workbook
Dim XBlatt, wks2 As Worksheet
Dim XZeile As Long
Dim Suchart As String
Dim xOpt As Integer

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


Bild

Betrifft: Daten geändert ...
von: Matthias L
Geschrieben am: 10.11.2015 11:27:21
Hallo
Hatte grade Lust dazu, also Glück für Dich ;-)
https://www.herber.de/bbs/user/101376.xls
Gruß Matthias

Bild

Betrifft: vielen vielen Dank an Matthias
von: Thomas
Geschrieben am: 10.11.2015 11:47:19
Hallo Matthias,
ich freue mich riesig darüber auch das du Lust hattest super von Dir.
Ich habe es wirklich versucht schau Dir das mal an oh oh je.
Bitte aber gleich wieder vergessen.
vielen vielen dank thomas

Private Sub CommandButton7_Click()
Dim rng As Range
  Dim sSearch As String
  Dim intCounter As Integer
  'sSearch = ListBox1.Text
  'If sSearch = "" Then Exit Sub
Dim mldg
Dim spalte
Dim Zeile
Dim Stil
Dim titel
Dim ergebnis
Dim i
ListBox1.List(ListBox1.ListIndex, 1) = TextBox2
ListBox1.List(ListBox1.ListIndex, 2) = TextBox3
ListBox1.List(ListBox1.ListIndex, 3) = TextBox4
ListBox1.List(ListBox1.ListIndex, 4) = TextBox5
'Zeile = ActiveCell.Row
'Spalte = ActiveCell.Column
Dim wert() As String
'WE = UserForm1.TextBox2.Text
spalte = 15
Zeile = 2
'Cells (spalte & i)
'Zeile = TextBox3.Value
ActiveSheet.Cells(Zeile, spalte) = UserForm1.TextBox3.Text
'#######################################################
'#############################################################
'Range = List(ListIndex, 0)
'MsgBox Range
wert = Split(Range(Cells(2, 15)).Address, "$")
MsgBox wert(1) '& Chr(13)     '  spalten nummer
MsgBox wert(2) ' zeilennummer
'########################################################
'Tabellenname.Cells(1, 1).Value = TextBox1.Text
'Zeile.Offset(5, 3).Value = TextBox5.Text
End Sub


Bild

Betrifft: Danke für die Rückmeldung ... owT
von: Matthias L
Geschrieben am: 10.11.2015 12:13:09


 Bild

Beiträge aus den Excel-Beispielen zum Thema "daten ändern"