HERBERS Excel-Forum - das Archiv

Thema: Änderungen während eines Zeitraumes darstellen

Änderungen während eines Zeitraumes darstellen
Thomas

Hallo
ich habe zwei Code.
1) Mit diesem Code kann ich einen Datensatz (Leere Zeile mit Formeln).
Public Sub DatensatzEinfügen()
Dim lngRow5 As Long, lngRow6 As Long
Dim ws As Worksheet, wsV As Worksheet, z%
If TypeOf Selection Is Range Then
Set ws = ActiveSheet
Set wsV = ThisWorkbook.Worksheets("Datensatz")
lngRow5 = ThisWorkbook.Names("Anfang").RefersToRange.Row
lngRow6 = ThisWorkbook.Names("Ende").RefersToRange.Row
Selection.Cells(1, 1).Select
Application.EnableEvents = False
If Selection.Row > lngRow5 And Selection.Row < lngRow6 Then
With Worksheets("Aufstellung")
Worksheets("Aufstellung").Unprotect Password:="sperl"
Selection.EntireRow.Insert Shift:=xlDown
z = ActiveCell.Row
wsV.Rows("5:5").Copy ws.Range("A" & z)
Worksheets("Aufstellung").Protect Password:="sperl"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True
End With
Else
Call MsgBox("Außerhalb des gültigen Bereichs.", vbExclamation, "Hinweis")
End If
Else
Call MsgBox("Bitte eine Zeile auswählen.", vbExclamation, "Hinweis")
End If
End Sub
2) Mit diesem Code kann ich einen Datensatz in Abhängigkeit eines Kriteriums (Entfällt)in zwei andere Blätter verschieben
Sub DatensatzVerschieben()
Worksheets("Aufstellung").Unprotect Password:="sperl"
Worksheets("Lager BSK").Unprotect Password:="sperl"
Worksheets("Lager STS").Unprotect Password:="sperl"
Dim TB1, TB2, TB3, i&, LR1&, LR2&, LR3&
Set TB1 = Sheets("Aufstellung")
Set TB2 = Sheets("Lager BSK")
Set TB3 = Sheets("Lager STS")
LR1 = TB1.Cells.SpecialCells(xlCellTypeLastCell).Row 'Letzte Zeile
For i = LR1 To 1 Step -1
If TB1.Cells(i, 69).Value = "Entfällt" Then
LR2 = TB2.Cells.SpecialCells(xlCellTypeLastCell).Row 'Letzte Zeile
LR3 = TB3.Cells.SpecialCells(xlCellTypeLastCell).Row 'Letzte Zeile
TB1.Rows(i).Copy TB2.Rows(LR2 + 1)
TB1.Rows(i).Copy TB3.Rows(LR3 + 1)
TB1.Rows(i).Delete
End If
Next
Worksheets("Aufstellung").Protect Password:="sperl"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True
Worksheets("Lager BSK").Protect Password:="sperl"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True
Worksheets("Lager STS").Protect Password:="sperl"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True
End Sub
Mein Problem ist, dass ich Änderungen visualisieren muss.
d.h. sobald eine Zeile eingefügt oder in ein anderes Blatt verschoben wird, soll immer auch das Datum über die Änderung irgendwo abgespeichert werden. Das Ganze kann gerne auch in einer Zelle des eingefügten oder verschobenen Datensatzes gemacht werden.
Ich möchte dann in einer Userform ein Anfangs –und Enddatum auswählen können.
Alle Datensätze deren Änderungsdatum (Einfügedatum oder Verschiebedatum) innerhalb oder gleich dem Datumsgrenzen ist, werden farbig schattiert (die ganze Zeile).
Die Schwierigkeit dabei ist, dass das der Datensatz nur im Tabellenblatt „Aufstellung“ eingefügt wird.
Verschoben werden die Datensätze in die Tabellenblätter Lager BSK und Lager STS.
Wird der Datensatz aus „Aufstellungen“ nach Lager BSK verschoben, dann soll das Verschiebedatum im Tabellenblatt „Lager BSK“ Stehen.
Zur besseren Übersicht meine Datei.
https://www.herber.de/bbs/user/101239.xlsm
Hat hierzu jemand eine Idee?

AW: Änderungen während eines Zeitraumes darstellen
fcs

Hallo Thomas,
das Anlegen eines neuen Datensatzes kannst du so dokumentieren: 
        z = ActiveCell.Row
wsV.Rows("5:5").Copy ws.Range("A" & z)
ws.Range("FC" & z).Value = Date 'Spalte "FC" ggf. anpassen
Worksheets("Aufstellung").Protect Password:="sperl"
Für das Verschieben entsprechend: 
    TB1.Rows(i).Copy TB2.Rows(LR2 + 1)
TB2.Cells(LR2 + 1, 159).Value = Date '159 = Spalte "FC" - ggf anpassen
TB1.Rows(i).Copy TB3.Rows(LR3 + 1)
TB3.Cells(LR2 + 1, 159).Value = Date '159 = Spalte "FC" - ggf anpassen
Gruß
Franz

Änderungen während eines Zeitraumes darstellen
Thomas

Hallo
ich habe zwei Code.
1) Mit diesem Code kann ich einen Datensatz (Leere Zeile mit Formeln).
Public Sub DatensatzEinfügen()
Dim lngRow5 As Long, lngRow6 As Long
Dim ws As Worksheet, wsV As Worksheet, z%
If TypeOf Selection Is Range Then
Set ws = ActiveSheet
Set wsV = ThisWorkbook.Worksheets("Datensatz")
lngRow5 = ThisWorkbook.Names("Anfang").RefersToRange.Row
lngRow6 = ThisWorkbook.Names("Ende").RefersToRange.Row
Selection.Cells(1, 1).Select
Application.EnableEvents = False
If Selection.Row > lngRow5 And Selection.Row < lngRow6 Then
With Worksheets("Aufstellung")
Worksheets("Aufstellung").Unprotect Password:="sperl"
Selection.EntireRow.Insert Shift:=xlDown
z = ActiveCell.Row
wsV.Rows("5:5").Copy ws.Range("A" & z)
Worksheets("Aufstellung").Protect Password:="sperl"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True
End With
Else
Call MsgBox("Außerhalb des gültigen Bereichs.", vbExclamation, "Hinweis")
End If
Else
Call MsgBox("Bitte eine Zeile auswählen.", vbExclamation, "Hinweis")
End If
End Sub
2) Mit diesem Code kann ich einen Datensatz in Abhängigkeit eines Kriteriums (Entfällt)in zwei andere Blätter verschieben
Sub DatensatzVerschieben()
Worksheets("Aufstellung").Unprotect Password:="sperl"
Worksheets("Lager BSK").Unprotect Password:="sperl"
Worksheets("Lager STS").Unprotect Password:="sperl"
Dim TB1, TB2, TB3, i&, LR1&, LR2&, LR3&
Set TB1 = Sheets("Aufstellung")
Set TB2 = Sheets("Lager BSK")
Set TB3 = Sheets("Lager STS")
LR1 = TB1.Cells.SpecialCells(xlCellTypeLastCell).Row 'Letzte Zeile
For i = LR1 To 1 Step -1
If TB1.Cells(i, 69).Value = "Entfällt" Then
LR2 = TB2.Cells.SpecialCells(xlCellTypeLastCell).Row 'Letzte Zeile
LR3 = TB3.Cells.SpecialCells(xlCellTypeLastCell).Row 'Letzte Zeile
TB1.Rows(i).Copy TB2.Rows(LR2 + 1)
TB1.Rows(i).Copy TB3.Rows(LR3 + 1)
TB1.Rows(i).Delete
End If
Next
Worksheets("Aufstellung").Protect Password:="sperl"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True
Worksheets("Lager BSK").Protect Password:="sperl"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True
Worksheets("Lager STS").Protect Password:="sperl"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True
End Sub
Mein Problem ist, dass ich Änderungen visualisieren muss.
d.h. sobald eine Zeile eingefügt oder in ein anderes Blatt verschoben wird, soll immer auch das Datum über die Änderung irgendwo abgespeichert werden. Das Ganze kann gerne auch in einer Zelle des eingefügten oder verschobenen Datensatzes gemacht werden.
Ich möchte dann in einer Userform ein Anfangs –und Enddatum auswählen können.
Alle Datensätze deren Änderungsdatum (Einfügedatum oder Verschiebedatum) innerhalb oder gleich dem Datumsgrenzen ist, werden farbig schattiert (die ganze Zeile).
Die Schwierigkeit dabei ist, dass das der Datensatz nur im Tabellenblatt „Aufstellung“ eingefügt wird.
Verschoben werden die Datensätze in die Tabellenblätter Lager BSK und Lager STS.
Wird der Datensatz aus „Aufstellungen“ nach Lager BSK verschoben, dann soll das Verschiebedatum im Tabellenblatt „Lager BSK“ Stehen.
Zur besseren Übersicht meine Datei.
https://www.herber.de/bbs/user/101239.xlsm
Hat hierzu jemand eine Idee?

AW: Änderungen während eines Zeitraumes darstellen
fcs

Hallo Thomas,
das Anlegen eines neuen Datensatzes kannst du so dokumentieren: 
        z = ActiveCell.Row
wsV.Rows("5:5").Copy ws.Range("A" & z)
ws.Range("FC" & z).Value = Date 'Spalte "FC" ggf. anpassen
Worksheets("Aufstellung").Protect Password:="sperl"
Für das Verschieben entsprechend: 
    TB1.Rows(i).Copy TB2.Rows(LR2 + 1)
TB2.Cells(LR2 + 1, 159).Value = Date '159 = Spalte "FC" - ggf anpassen
TB1.Rows(i).Copy TB3.Rows(LR3 + 1)
TB3.Cells(LR2 + 1, 159).Value = Date '159 = Spalte "FC" - ggf anpassen
Gruß
Franz

Dialog-Beispiele
Bewerten Sie hier bitte das Excel-Portal