Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Track Changes mittels VBA
#21
Nunja, die Zeile

Code:
If Target.Column = SPALTE_AENDERUNG Then
entscheidet, auf welche Spaltenänderung reagiert wird. Wenn es mehrere Spalten sein sollen, musst Du das an dieser Stelle ergänzen.
Z.B. wenn alle Spalten von 1 bis 8 relevant sein sollen, wäre

Code:
If Target.Column <=8 Then
eine Möglichkeit.

Die Zellen die kopiert werden, werden mit den Zeilen kopiert, die alle so anfangen:

Code:
ActiveWorkbook.Worksheets(LOG_BLATT).Cells(LetzteZeile + 1, .......
Hier kannst Du noch die Zellen dazuschreiben, die ebenfalls kopiert werden sollen. Einfach so eine Zeile kopieren, unten anhängen und anpassen.

Gruß
Sebastian
Antworten Top
#22
Moin Sebastian,

ich bekomme es einfach nicht hin das er mir den kompletten Bereich kopiert
Code:
If Target.Column <=8 Then

Wo muss ich den Code reinkopieren 
Code:
Option Explicit
Const SPALTE_AENDERUNG = 8 'Nummer der Spalte auf deren Änderung reagiert wird
Const SPALTE_DATUM = 8 'Nummer der Spalte die das zu übertragende Datum enthält

Const LOG_BLATT = "Data" 'Name des Blattes, das das Log enthält
'#

Private Sub Worksheet_Change(ByVal Target As Range) 'Event bei Ändern eines Zelleninhalts

Dim Datum As Long
Dim LetzteZeile As Long
Dim Blattname As String

If Target.Column = SPALTE_AENDERUNG Then
  Datum = Cells(Target.Row, SPALTE_DATUM)
  Blattname = ActiveSheet.Name
 
  LetzteZeile = TabellenendeSuchen(LOG_BLATT, 1)
  ActiveWorkbook.Worksheets(LOG_BLATT).Cells(LetzteZeile + 1, 1) = Blattname
  ActiveWorkbook.Worksheets(LOG_BLATT).Cells(LetzteZeile + 1, 2) = Datum
  ActiveWorkbook.Worksheets(LOG_BLATT).Cells(LetzteZeile + 1, 3) = Environ("UserName") 'Application.UserName
  ActiveWorkbook.Worksheets(LOG_BLATT).Cells(LetzteZeile + 1, 4) = Now
 
  ActiveWorkbook.Worksheets(LOG_BLATT).Columns(2).NumberFormat = "dd/mm/yyyy"
  ActiveWorkbook.Worksheets(LOG_BLATT).Columns(4).NumberFormat = "dd/mm/yyyy"
End If

End Sub
Function TabellenendeSuchen(Arbeitsblatt As String, Spalte As Integer) As Long

TabellenendeSuchen = ActiveWorkbook.Worksheets(Arbeitsblatt).Cells(Rows.Count, Spalte).End(xlUp).Row

End Function

und was muss ich mit der Funktion machen damit er den Bereich kopiert 
PHP-Code:
ActiveWorkbook.Worksheets(LOG_BLATT).Cells(LetzteZeile 15) = ???? 

Sorry schon mal für die Dummen Fragen.
MfG
XenOn655
Antworten Top
#23
Ersetz mal die gesamte Funktion mit folgendem Code:
Code:
Private Sub Worksheet_Change(ByVal Target As Range) 'Event bei Ändern eines Zelleninhalts

Dim LetzteZeile As Long
Dim Blattname As String

If Target.Column <= 9 Then
   
   Blattname = ActiveSheet.Name
   Range(Cells(Target.Row, 1), Cells(Target.Row, 9)).Copy
   
   LetzteZeile = TabellenendeSuchen(LOG_BLATT, 1)
   
   ActiveWorkbook.Worksheets(LOG_BLATT).Cells(LetzteZeile + 1, 1) = Blattname
   ActiveWorkbook.Worksheets(LOG_BLATT).Cells(LetzteZeile + 1, 2).PasteSpecial
   ActiveWorkbook.Worksheets(LOG_BLATT).Cells(LetzteZeile + 1, 11) = Environ("UserName") 'Application.UserName
   ActiveWorkbook.Worksheets(LOG_BLATT).Cells(LetzteZeile + 1, 12) = Now
   
   ActiveWorkbook.Worksheets(LOG_BLATT).Columns(6).NumberFormat = "dd/mm/yyyy"
   ActiveWorkbook.Worksheets(LOG_BLATT).Columns(7).NumberFormat = "dd/mm/yyyy"
   ActiveWorkbook.Worksheets(LOG_BLATT).Columns(9).NumberFormat = "dd/mm/yyyy"
   ActiveWorkbook.Worksheets(LOG_BLATT).Columns(12).NumberFormat = "dd/mm/yyyy hh:mm"
   
End If

End Sub
Jetzt wird bei jeder Änderung in einer der ersten 9 Spalten der Inhlt der ersten 9 Spalten komplett kopiert. Plus Maschinenbezeichnung, Benutzer und Datum.

Gruß
Sebastian
Antworten Top
#24
(10.04.2019, 08:51)Bast4i schrieb: Ersetz mal die gesamte Funktion mit folgendem Code:
Code:
Private Sub Worksheet_Change(ByVal Target As Range) 'Event bei Ändern eines Zelleninhalts

Dim LetzteZeile As Long
Dim Blattname As String

If Target.Column <= 9 Then
   
   Blattname = ActiveSheet.Name
   Range(Cells(Target.Row, 1), Cells(Target.Row, 9)).Copy
   
   LetzteZeile = TabellenendeSuchen(LOG_BLATT, 1)
   
   ActiveWorkbook.Worksheets(LOG_BLATT).Cells(LetzteZeile + 1, 1) = Blattname
   ActiveWorkbook.Worksheets(LOG_BLATT).Cells(LetzteZeile + 1, 2).PasteSpecial
   ActiveWorkbook.Worksheets(LOG_BLATT).Cells(LetzteZeile + 1, 11) = Environ("UserName") 'Application.UserName
   ActiveWorkbook.Worksheets(LOG_BLATT).Cells(LetzteZeile + 1, 12) = Now
   
   ActiveWorkbook.Worksheets(LOG_BLATT).Columns(6).NumberFormat = "dd/mm/yyyy"
   ActiveWorkbook.Worksheets(LOG_BLATT).Columns(7).NumberFormat = "dd/mm/yyyy"
   ActiveWorkbook.Worksheets(LOG_BLATT).Columns(9).NumberFormat = "dd/mm/yyyy"
   ActiveWorkbook.Worksheets(LOG_BLATT).Columns(12).NumberFormat = "dd/mm/yyyy hh:mm"
   
End If

End Sub
Jetzt wird bei jeder Änderung in einer der ersten 9 Spalten der Inhlt der ersten 9 Spalten komplett kopiert. Plus Maschinenbezeichnung, Benutzer und Datum.

Gruß
Sebastian
Moin,

habe jetzt die Funktion ersetzt und jetzt stürzt Excel ab. Oder muss ich die Const rausnehmen?
PHP-Code:
Option Explicit
Const SPALTE_AENDERUNG 'Nummer der Spalte auf deren Änderung reagiert wird
Const SPALTE_DATUM = 9 '
Nummer der Spalte die das zu übertragende Datum enthält

Const LOG_BLATT "Data" 'Name des Blattes, das das Log enthält
Private Sub Worksheet_Change(ByVal Target As Range) '
Event bei Ändern eines Zelleninhalts

Dim LetzteZeile 
As Long
Dim Blattname 
As String

If Target.Column <= 9 Then
   
   Blattname 
ActiveSheet.Name
   Range
(Cells(Target.Row1), Cells(Target.Row9)).Copy
   
   LetzteZeile 
TabellenendeSuchen(LOG_BLATT1)
   
   ActiveWorkbook
.Worksheets(LOG_BLATT).Cells(LetzteZeile 11) = Blattname
   ActiveWorkbook
.Worksheets(LOG_BLATT).Cells(LetzteZeile 12).PasteSpecial
   ActiveWorkbook
.Worksheets(LOG_BLATT).Cells(LetzteZeile 111) = Environ("UserName"'Application.UserName
   ActiveWorkbook.Worksheets(LOG_BLATT).Cells(LetzteZeile + 1, 12) = Now
   
   ActiveWorkbook.Worksheets(LOG_BLATT).Columns(6).NumberFormat = "dd/mm/yyyy"
   ActiveWorkbook.Worksheets(LOG_BLATT).Columns(7).NumberFormat = "dd/mm/yyyy"
   ActiveWorkbook.Worksheets(LOG_BLATT).Columns(9).NumberFormat = "dd/mm/yyyy"
   ActiveWorkbook.Worksheets(LOG_BLATT).Columns(12).NumberFormat = "dd/mm/yyyy hh:mm"
   
End If

End Sub
Function TabellenendeSuchen(Arbeitsblatt As String, Spalte As Integer) As Long

TabellenendeSuchen = ActiveWorkbook.Worksheets(Arbeitsblatt).Cells(Rows.Count, Spalte).End(xlUp).Row

End Function 
Antworten Top
#25
Dann reicht diese Code

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
   if target.count>1 then exit sub

   If Target.Column < 10 Then
     sn=target.offset(, 1-target.column).resize(,11)
     sn(1,10)= Environ("UserName")
     sn(1,11)= now

     with sheets("LOG_BLATT").cells(rows.count,1).end(xlup).offset(1)
       .value = target.parent.name
       .offset(,1).resize(,ubound(sn))=sn
     end with
   end if
End Sub
Zum übersetzen von Excel Formeln:

http://dolf.trieschnigg.nl/excel/index.p...gids=en+de
Antworten Top
#26
Nein, die Const müssen schon drinbleiben. Nur die Funktion ersetzen.
Lad mal Deine Datei hoch. Bei mir funktioniert alles.

Gruß
Sebastian
[-] Folgende(r) 1 Nutzer sagt Danke an Bast4i für diesen Beitrag:
  • XenOn655
Antworten Top
#27
(10.04.2019, 10:05)Bast4i schrieb: Nein, die Const müssen schon drinbleiben. Nur die Funktion ersetzen.
Lad mal Deine Datei hoch. Bei mir funktioniert alles.

Gruß
Sebastian

Hier habe ich die Datei angehängt. Die angehängten PDF's sind nicht relevant oder?


Angehängte Dateien
.xlsm   Wartungsplan_MAKRO.xlsm (Größe: 61,32 KB / Downloads: 8)
Antworten Top
#28
Schon mal getestet ? https://www.clever-excel-forum.de/thread...#pid156866
Zum übersetzen von Excel Formeln:

http://dolf.trieschnigg.nl/excel/index.p...gids=en+de
Antworten Top
#29
(10.04.2019, 14:45)snb schrieb: Schon mal getestet ? https://www.clever-excel-forum.de/thread...#pid156866

Ja funktioniert bei mir auch nicht

MfG
XenOn655
Antworten Top
#30
*push*
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste