Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Userform
BildScreenshot zu Userform Userform-Seite mit Beispielarbeitsmappe aufrufen

Excel VBA


Betrifft: Excel VBA von: Bernd
Geschrieben am: 18.09.2019 08:14:23

Mit VBA Werte aus Userform in 2 verschiedene Tabellenblätter und in verschiedene Zeilen schreiben?

Hallo ich habe ein problem.

Ich habe in Tabelle1 die Adressen stehen und in Tabelle2 stehen die aktuellen Werte von bestimmten Personen. Z.B. Herr Mayer steht in Tabelle1 in Zeile3 aber in Tabelle2 in Zeile15
wenn ich nun über den Button der Userform auf ändern gehe speichert er mir zwar beides in die jeweiligen Tabellenblätter aber im Tabellenblatt2 auch in Zeile3.
Ich bedanke mich schon mal im voraus für eure Unterstützung.

   Private Sub cmbÄndern_Click()
   
   'Ein Tabellenblatt aktivieren
   
   Worksheets("Adressen").Activate
   
   Dim rng As Range
   
   Dim lngZeile As Long
   
   'Spalte A nach Wert durchsuchen
   
   Set rng = Sheets("Adressen").Range("A:A").Find(What:=txtName.Value, LookAt:=xlWhole, LookIn:= _
   xlValues)
   
   'Wenn Wert gefunden
   
   If Not rng Is Nothing Then
   
      lngZeile = rng.Row
   
      ActiveSheet.Cells(lngZeile, 2).Value = txtVorname
   
      ActiveSheet.Cells(lngZeile, 3).Value = txtStraße
   
      ActiveSheet.Cells(lngZeile, 4).Value = txtPLZ
   
      ActiveSheet.Cells(lngZeile, 5).Value = txtOrt
   
      ActiveSheet.Cells(lngZeile, 6).Value = txtTelefon
   
      ActiveSheet.Cells(lngZeile, 7).Value = txtHandy
   
      ActiveSheet.Cells(lngZeile, 8).Value = txtMail
   
      ActiveSheet.Cells(lngZeile, 9).Value = txtGeburtstag
   
      ActiveSheet.Cells(lngZeile, 10).Value = cmbAnrede
   
      ActiveSheet.Cells(lngZeile, 11).Value = txtbemerkung
   
   'Ein Tabellenblatt aktivieren
   
   Worksheets("2019").Activate
   
   Dim rng As Range
   
   Dim lngZeile As Long
   
   Set rng = Sheets("2019").Range("A:A").Find(What:=txtName.Value, LookAt:=xlWhole, LookIn:= _
   xlValues)
   
      Worksheets("2019").Cells(lngZeile, 2).Value = txtVorname
   
      Worksheets("2019").Cells(lngZeile, 6).Value = txtTelefon
   
      Worksheets("2019").Cells(lngZeile, 7).Value = txtHandy
   
      Worksheets("2019").Cells(lngZeile, 8).Value = txtMail
   
      MsgBox ("Daten übertragen")
   
    End If
   
   'Formular schließen
   
   Unload Me
   
   End Sub

  

Betrifft: AW: Excel VBA von: 1713582.html
Geschrieben am: 18.09.2019 08:18:53

Hallo,

du musst

lngZeile
beim zweiten Find neu belegen mit der Zeilennummer. Sonst behaelt es die Zeilennummer vom vorherigen Find.
Also:
Set rng = Sheets("2019").Range("A:A").Find(What:=txtName.Value, LookAt:=xlWhole, LookIn:= _
xlValues)
lngZeile = rng.Row

Gruss Torsten
  

Betrifft: AW: Excel VBA von: 1713638.html
Geschrieben am: 18.09.2019 12:42:33

Hallo Bernd,

1. die Variable lngZeile brauchst du nicht, du kannst mit rng.Row die Zeile auch aus der rng Variablen holen

2. bitte ohne Activate der Blätter

3. mit .Cells(rng.Row, 4).Value = txtPLZ schreibst du Text in die Zelle und keine Zahl

4. mit .Cells(rng.Row, 9).Value = txtGeburtstag schreibst du Text in die Zelle und kein Datum

5. sollten Variablen die mit Set gesetzt wurden am Ende des Codes wieder geleert werden

Private Sub cmbÄndern_Click()
Dim rng As Range, boGefunden As Boolean

'Prüfung auf Zahl
If Not IsNumeric(txtPLZ) Then
    MsgBox "Fehler: Wert ist nicht numerisch."
    txtPLZ.SetFocus
    Exit Sub
End If

'Prüfung auf Datum
If Not IsDate(txtGeburtstag) Then
    MsgBox "Fehler: Kein gültiges Datum."
    txtGeburtstag.SetFocus
    Exit Sub
End If

With Worksheets("Adressen")
    Set rng = .Range("A:A").Find(What:=txtName, LookAt:=xlWhole, LookIn:=xlValues)
    If Not rng Is Nothing Then
        boGefunden = True
        .Cells(rng.Row, 2).Value = txtVorname
        .Cells(rng.Row, 3).Value = txtStraße
        .Cells(rng.Row, 4).Value = CLng(txtPLZ)
        .Cells(rng.Row, 5).Value = txtOrt
        .Cells(rng.Row, 6).Value = txtTelefon
        .Cells(rng.Row, 7).Value = txtHandy
        .Cells(rng.Row, 8).Value = txtMail
        .Cells(rng.Row, 9).Value = CDate(txtGeburtstag)
        .Cells(rng.Row, 10).Value = cmbAnrede
        .Cells(rng.Row, 11).Value = txtBemerkung
    End If
End With

With Worksheets("2019")
    Set rng = .Range("A:A").Find(What:=txtName, LookAt:=xlWhole, LookIn:=xlValues)
    If Not rng Is Nothing Then
        boGefunden = True
        .Cells(rng.Row, 2).Value = txtVorname
        .Cells(rng.Row, 6).Value = txtTelefon
        .Cells(rng.Row, 7).Value = txtHandy
        .Cells(rng.Row, 8).Value = txtMail
    End If
End With

If boGefunden Then
    MsgBox "Daten übertragen"
Else
    MsgBox "Der Name " & txtName & " wurde nicht gefunden."
End If

Unload Me

Set rng = Nothing
End Sub
Gruß Werner
  

Betrifft: AW: Excel VBA von: 1713683.html
Geschrieben am: 18.09.2019 15:16:42

Hallo Torsten & Hallo Werner,
ich danke euch beiden für die schnelle und tollen lösungen ich habe die von Torsten schon ausprobiert und sie funktioniert. Hete abend werde ich noch deine Werner ausprobieren. vielen Dank. Ich habe mir bestimmt schon 2 Wochen darüber den Kopf zerbrochen. Vielen, vielen lieben Dank.
Liebe Grüße Bernd