Logging - eine Spalte mit Formeln...

Frage: In Spalte A wird eine Formel eingesetzt. Diese bezieht sich auf Spalte B, C und D (Verketten). Nun möchte ich den entsprechenden Wert aus Spalte A in einem extra Tabellenblatt speichern (den Neuesten immer oben), sobald ein Wert in Spalte B, C oder D geändert wird (Logging).

In column A, a formula is used. This refers to column B, C and D (concatenate). Now I want to save the corresponding value from column A in a separate worksheet (the latest always above) when a value in column B, C or D is changed (logging).

Hier noch eine Beispieldatei / Here's a sample file:
Logging - eine Spalte mit Formeln...[XLS 60 KB]

Option Explicit
'-------------------------------------------------------------------------- 
' Module    : Tabelle1 
' Procedure : Worksheet_Change 
' Author    : Case (Ralf Stolzenburg) 
' Date      : 03.01.2013 
' Purpose   : Log 1 Columns - Formula 
'-------------------------------------------------------------------------- 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lngCalc As Long
    On Error GoTo Fin
    ' Die Excelapplikation wird ruhig gestellt 
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        lngCalc = .Calculation
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
    End With
    ' Wenn NICHT mehr als eine Zelle ausgewählt ist dann... 
    If Not Target.Count > 1 Then
        ' Wurde die Änderung in Spalte B, C oder D gemacht... 
        If Not Intersect(Target, Columns("B:D")) Is Nothing Then
            ' Beziehe dich auf das Tabellenblatt "Log" 
            With ThisWorkbook.Worksheets("Log")
                ' Wenn die Zielspalte NICHT leer ist dann... 
                If Application.WorksheetFunction.CountA _
                    (.Columns(Target.Row)) <> 0 Then
                    ' Übertrage die Änderung in die ERSTE Zeile der 
                    ' JEWEILIGEN Spalte 
                    .Cells(1, Target.Row).Value = Cells(Target.Row, 1).Value
                    ' Kommentar mit Datum, Uhrzeit und Benutzer 
                    .Cells(1, Target.Row).AddComment Date & Chr(10) & _
                        Time & Chr(10) & Chr(10) & Environ("USERNAME")
                    ' Zeile einfügen 
                    .Cells(1, 1).EntireRow.Insert
                ' Wenn die Zielspalte leer ist dann... bzw. sonst... 
                Else
                    ' Übertrage die Änderung in die ZWEITE Zeile der 
                    ' JEWEILIGEN Spalte 
                    .Cells(2, Target.Row).Value = Cells(Target.Row, 1).Value
                    ' Kommentar mit Datum, Uhrzeit und Benutzer 
                    .Cells(2, Target.Row).AddComment Date & Chr(10) & _
                        Time & Chr(10) & Chr(10) & Environ("USERNAME")
                End If
            End With
        End If
    End If
Fin:
    ' Die Applikation aufwecken 
    With Application
        .ScreenUpdating = True
        .AskToUpdateLinks = True
        .EnableEvents = True
        .Calculation = lngCalc
        .DisplayAlerts = True
        .CutCopyMode = True
    End With
    ' Wenn ein Fehler auftritt gib ihn aus mit Fehlernummer und Beschreibung 
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub

Beliebte Posts aus diesem Blog

Formeln - auch Array - per VBA eintragen...

Alle Dateien eines Ordners - Optional mit Unterordner

Excel -> Word in Textmarken (Bookmarks)...