Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1684to1688
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Änderungshistorie verändern

Änderungshistorie verändern
05.04.2019 09:58:57
Chris
Hallo zusammen, ich habe diesen Code vorliegen und möchte in der Änderungshistorie weitere Spalten hinzufügen, bei denen auch geänderte Werte aus der Haupttabelle in die Änderungshistorie kommen. Leider verstehe ich den Code nicht ganz und weiß nicht wie ich das machen kann, hat einer eine Idee ?
'Was steht in welcher Spalte
'Spalten der Tabelle Änderungshistorie
Private Const sDatum = 2
Private Const sTyp = 3
Private Const sID = 1
Private Const sARID = 4 'spalte Änderungdhistorie Reifen ID
Private Const sReifen = 5
Private Const sSpalte = 6
Private Const sAenderung = 7
Private Const sErsteller = 8
'Spalte in der, der Hersteller, die Sachnummer usw. steht
Private Const sDimension = 2
Private Const sSachnr = 14
Private Const sHersteller = 15
Private Const sRoWi = 18
Private Const sRID = 1
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.ScreenUpdating = False
Dim Rng As Range
Dim letzteZeileSicherungskopie As Long, letzteZeile As Long, letzteSpalte As Long
Dim i As Long, j As Long, i_tmp As Long
Dim tmpStrValue As String, tmpStrColumn As String, Reifen As String, Praefix As String 'Für  _
_
Änderungshistorie
Dim Baureihe As String
Dim RoWi As Worksheet, Kopie As Worksheet, Historie As Worksheet
Dim Hinzugefügt As Boolean 'sagt aus ob der reifen neu hinzugefügt wurde oder nicht
Dim ID As Integer, RID As String   'Für Änderungshistorie
Hinzugefügt = True
Set RoWi = Worksheets("RoWi-Tabelle")
Set Kopie = Worksheets("Kopie")
Set Historie = Worksheets("Änderungshistorie")
Historie.Unprotect Password:="7sieben7"
Baureihe = Range("G4")
If RoWi.FilterMode Then RoWi.ShowAllData        'Filter zurücksetzen wenn welche gesetzt  _
waren
If Kopie.FilterMode Then Kopie.ShowAllData
letzteZeile = RoWi.Cells(Rows.Count, 1).End(xlUp).Row
letzteZeileSicherungskopie = Kopie.Cells(Rows.Count, 1).End(xlUp).Row
letzteSpalte = RoWi.Cells(4, Columns.Count).End(xlToLeft).Column
'nach zoll größe sortieren
Call Sortieren
For i_tmp = 9 To letzteZeile
For i = 9 To letzteZeileSicherungskopie
If RoWi.Cells(i_tmp, 1) = Kopie.Cells(i, 1) Then                    'Überprüfen ob   _
_
etwas geändert wurde(Vergleich RoWi-Tabelle vs. Kopie Tabelle)
Hinzugefügt = False
For j = 1 To letzteSpalte
'Wurde etwas in bei dem reifen verändert
If RoWi.Cells(i_tmp, j).text  Kopie.Cells(i, j).text Then
'Schauen ob der Reifen schon in der Reifen spalte steht
'NEIN: hinzufüden
If InStr(Reifen, RoWi.Cells(i_tmp, sRID).text) = 0 Then
Praefix = "Geändert"
Reifen = RoWi.Cells(i_tmp, sDimension).text & " " & RoWi.Cells( _
i_tmp, sHersteller).text
RID = RoWi.Cells(i_tmp, sRID).text
End If
tmpStrValue = tmpStrValue + "Alt: " + Kopie.Cells(i, j).text + "; Neu: " _
_
+ RoWi.Cells(i_tmp, j).text + vbLf
If j  "" Then
Call HistorieFuellen(Historie, Praefix, RID, Reifen, tmpStrColumn,  _
tmpStrValue)
End If
End If
Next i
If Hinzugefügt = True Then
'es wurde eine Zeile hinzugefügt
Praefix = "Hinzugefügt"
Reifen = RoWi.Cells(i_tmp, sDimension).text & " " & RoWi.Cells(i_tmp, sHersteller).  _
_
text
RID = RoWi.Cells(i_tmp, sRID).text
Call HistorieFuellen(Historie, Praefix, RID, Reifen, tmpStrColumn, tmpStrValue)
End If
Hinzugefügt = True
Next i_tmp
For i = 9 To letzteZeileSicherungskopie
For i_tmp = 9 To letzteZeile
If RoWi.Cells(i_tmp, sRID).text = Kopie.Cells(i, sRID) Then
GoTo Nächster
End If
Next i_tmp
' Zeile wurden gelöscht
Praefix = "Gelöscht"
Reifen = Kopie.Cells(i, sDimension).text & " " & Kopie.Cells(i, sHersteller).text
RID = Kopie.Cells(i, sRID).text
Call HistorieFuellen(Historie, Praefix, RID, Reifen, tmpStrColumn, tmpStrValue)
Nächster:
Next i
weiter:
RoWi.Range("A1:DZ999").Copy
With Kopie
.Cells(1, 1).PasteSpecial Paste:=xlPasteAll
Application.CutCopyMode = False
End With
Application.ScreenUpdating = True
Historie.Protect Password:="7sieben7", AllowFiltering:=True
End Sub

Sub HistorieFuellen(Historie As Worksheet, Praefix As String, RID As String, Reifen As String, tmpStrColumn As String, tmpStrValue As String)
If Historie.Cells(6, sID) = "" Then
ID = 1
Else
ID = Historie.Cells(6, sID) + 1
End If
'neue Zeile einfügen
Historie.Rows(6).Insert Shift:=xlDown
Historie.Rows(7).Copy
Historie.Rows(6).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
' Präfix
Historie.Cells(6, sTyp) = Praefix
' Änderungs-Datum
Historie.Cells(6, sDatum) = Now
' Index des Datensatzes
Historie.Cells(6, sID) = ID
'ID des Reifens
Historie.Cells(6, sARID) = RID
' Reifen-Bezeichnung
Historie.Cells(6, sReifen) = Reifen
' Spalte der Änderung
Historie.Cells(6, sSpalte) = tmpStrColumn
' Geänderte Werte
Historie.Cells(6, sAenderung) = tmpStrValue
' Änderungs-Autor
Historie.Cells(6, sErsteller) = Application.UserName
Praefix = ""
RID = ""
Reifen = ""
tmpStrValue = ""
tmpStrColumn = ""
End Sub

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Änderungshistorie verändern
05.04.2019 19:02:10
ChrisL
Hi Chris
Eine Beispieldatei wäre nett gewesen...
Zeile 4 wird geprüft
letzteSpalte = RoWi.Cells(4, Columns.Count).End(xlToLeft).Column
unbekanntes Kapitel
Call Sortieren
nicht vergessen...
RoWi.Range("A1:DZ999").Copy
cu
Chris
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige