Herbers Excel-Forum - das Archiv
Per Cmd-Button Datenübernahme mit Vergleich | Herbers Excel-Forum
- Per Cmd-Button Datenübernahme mit Vergleich von Sascha vom 03.01.2010 15:08:40
- AW: Per Cmd-Button Datenübernahme mit Vergleich - von fcs am 04.01.2010 05:49:33
- AW: Per Cmd-Button Datenübernahme mit Vergleich - von Sascha am 04.01.2010 20:30:48
- AW: Per Cmd-Button Datenübernahme mit Vergleich - von Sascha am 04.01.2010 20:30:48
Betrifft: Per Cmd-Button Datenübernahme mit Vergleich
von: Sascha
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
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