Microsoft Excel

Herbers Excel/VBA-Archiv

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

Per Cmd-Button Datenübernahme mit Vergleich | Herbers Excel-Forum


Betrifft: Per Cmd-Button Datenübernahme mit Vergleich von: Sascha
Geschrieben am: 03.01.2010 15:08:40

Hallo Zusammen,

in anhängender Liste habe ich ein Makro, was nicht das tut was es soll.
Da ich mich mit VBA nicht auskenne ersuche ich eure Hilfe.

In der Fälligkeitenliste soll mittles Klick auf "Zahlungen übernehmen" die per Checkbox ausgewählten Daten in C&D&E&F in die Felder M&N&O&P verschoben werden.
Der ausgewählte Datensatz muss also aus den Zellen links verschwinden.
Wenn in J kein Datum eingetragen ist soll das Datum in E übernommen werden, ist ein Datum in J eingetragen welches abweichend zu E ist, soll dieses in Spalte O übernommen werden.

Ist keine Checkbox ausgewählt sollen auch keine Daten verschoben werden.

Hat jemand eine Idee? Ist sicherlich nichts großes für jemanden, der sich mit VBA etwas auskennt, leider gehöre ich nicht dazu :(

Vielen Dank für eure Unterstützung.

LG
Sascha

https://www.herber.de/bbs/user/66948.xls

  

Betrifft: AW: Per Cmd-Button Datenübernahme mit Vergleich von: fcs
Geschrieben am: 04.01.2010 05:49:33

Hallo Sascha,

wenn ichs richtig verstanden hab, dann müsste mit folgender Version des Makros funktionieren.

Gruß
Franz

Sub Test()
  Dim objB As Shape
  Dim ZeileQ As Long, ZeileZ As Long
  
  With Sheets("Fälligkeitenliste")
    For Each objB In .Shapes
     
     If objB.Name Like "Check Box*" Then
        'Datenzeile zur Checkbox
        ZeileQ = objB.TopLeftCell.Row + 1
        'CheckBox aktiv ?
        If objB.OLEFormat.Object.Value = 1 Then
          'Nächste frei Zeile in Spalte M
          ZeileZ = .Cells(.Rows.Count, 13).End(xlUp).Row + 1
          .Cells(ZeileZ, 13) = .Cells(ZeileQ, 3) 'C --> M
          .Cells(ZeileZ, 14) = .Cells(ZeileQ, 4) 'D --> N
          If .Cells(ZeileQ, 5) <> .Cells(ZeileQ, 10) And .Cells(ZeileQ, 10) <> "" Then
            ' und Datum in E und J ist nicht gleich
            .Cells(ZeileZ, 15) = .Cells(ZeileQ, 10) 'J --> O
          Else
            ' und Datum in E ist gleich bzw. J ist leer
            .Cells(ZeileZ, 15) = .Cells(ZeileQ, 5) 'E --> O
          End If
          .Cells(ZeileZ, 16) = .Cells(ZeileQ, 6) 'F --> P
          objB.OLEFormat.Object.Value = 0
          .Cells(ZeileQ, 10).ClearContents 'Eintrag in Spalte J löschen
          'Inhalte in Zeile in Datenquelle löschen
          With Worksheets("Datenquelle")
            .Range(.Cells(ZeileQ - 12, 2), .Cells(ZeileQ - 12, 4)).ClearContents
            .Cells(ZeileQ - 12, 6).ClearContents
          End With
        End If
     End If
    Next objB
  End With
  'Daten in Datenquelle nach Datum sortieren, um Leerzeilen nach unten zu bewegen
  With Worksheets("Datenquelle")
    With .Range(.Cells(2, 2), .Cells(450, 6))
      .Sort key1:=.Range("B1"), Order1:=xlAscending, Header:=xlYes
    End With
  End With
End Sub



  

Betrifft: AW: Per Cmd-Button Datenübernahme mit Vergleich von: Sascha
Geschrieben am: 04.01.2010 20:30:48

Hallo Franz,

vielen Dank für deine Mühen, das Makro funktioniert Prima.

LG
Sascha


Beiträge aus den Excel-Beispielen zum Thema "Per Cmd-Button Datenübernahme mit Vergleich"