Excel: Verbessertes Logging mit VBA Makro?

Hallo Zusammen

ich verwende im Moment ein kurzes Makro, um Änderungen in einem Tabellenblatt zu loggen.

Es registriert aber nur einzelne Änderungen, nicht multi-selektion oder Löschen von Spalten. Kann ich das mit separaten Privaten Subs übernehmen?

Und kann ich aufnehmen, was die Target- und "PreVal"-Adresse war (Offset 4+5)

Code:

Dim PreVal
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
PreVal = Target.Value
 
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
  
    On Error GoTo 0
    
    If Target.Value <> PreVal Then
        With Sheets(2).Cells(Rows.Count, 1).End(xlUp)
            .Offset(1, 0) = Now
            .Offset(1, 1) = PreVal
            .Offset(1, 2) = Target.Value
            .Offset(1, 3) = Environ("Username")
        End With
    End If
 
End Sub

1 Antwort

Suboptimierer

Von gutefrage auf Grund seines Wissens auf einem Fachgebiet ausgezeichneter Nutzer

Microsoft Excel

03.08.2021, 07:09

Du gehst direkt auf Target.Value. Er nimmt wahrscheinlich die Zelle der Selektion, die den Fokus hat (müsstest du einmal testen).

Target ist ein Range. Du kannst mit For Each durch diesen Range Zelle für Zelle iterieren.

For Each rZelle in Target
  ...
Next

Als globale Variable benötigst du wie es scheint ein doppeltes Array oder eine Liste / Matrix. Dort nimmst du in der ersten Spalte die einzelnen Zelladressen auf, in der zweiten den Wert der Zellen bei den Adressen.

In Worksheet_Change kannst du dann mittels Intersect prüfen, welche der global abgelegten Zelladressen in Target liegen und die Werte auf Änderung überprüfen.

Suboptimierer

03.08.2021, 07:10

Anstelle von globalen Variablen zu verwenden könntest du Zelladressen und Werte auch zum Beispiel auf einem unsichtbaren Arbeitsblatt ablegen (nur mal so als Tipp).

Ähnliche Fragen

Exel VBA? wert automatisch löschen?

Folgenden Code habe ich..

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$E$5" Then

Range("G5").Value = Range("G5").Value + Target.Value

End If

End Sub

Wie bekomme ich es hin, das sich nach eingabe von E5 der wert automatisch wieder löscht?

danke schon mal

...zur Frage

Wie kann Makros auf mehrere Zellen anwenden?

Hallo zusammen

Ich habe von einem von euch diesen Code für mein Problem erhalten.

Public dMerk As Double

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$A$7" And IsNumeric(Target) Then

Application.EnableEvents = False

On Error Resume Next

Range("A7").Value = dMerk + Target.Value

dMerk = Range("A7").Value

Application.EnableEvents = True

On Error GoTo 0

End If

End Sub

Jetzt möchte ich diesen jedoch nicht nur auf diese eine Zellle anwenden, sondern auf viele verschiedene. Wie kann ich das machen ohne für jede Zelle das Makro kopieren und den Bezug ändern muss.

Danke im voraus

...zur Frage

Excel Makro ausführen bei Änderung in einer Zelle in anderem Tabellenblatt?

Hallo zusammen,

ich habe ein Problem mit Excel, das vermutlich ganz leicht zu lösen ist, alleine komme ich aber nicht weiter.

Ich möchte gerne ein Makro immer bei einer Änderung in einer bestimmten Zelle ausführen lassen. Dazu habe ich bisher folgenden Code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range) Set Target = Intersect(Target, Range("A1")) If Target Is Nothing Then Exit Sub Else FooterLeft End If End Sub

Der funktioniert auch, bloß soll jetzt die aktivierende Zelle nicht A1 auf diesem Tabellenblatt sondern beispielsweise Zelle A6 auf dem Tabellenblatt "Deckblatt" sein.

Was muss ich hier wie umformulieren damit das klappt, oder brauche ich grundsätzlich eine ganz andere Funktion dazu?

Vielen lieben Dank!

...zur Frage

Beim ändern einer bestimmten Zelle Makro erneut ausführen?

Hallo,

ich habe folgendes Anliegen: Ich möchte in Excel mit VBA etwas machen. Hier einmal der Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("j10")) Is Nothing Then
    Select Case Range("j10").Value
        Case "manuell"
            Range("s7:u7").ClearContents
        Case "Anfang & Ende"
            Range("s7").Value = Worksheets("PEPStauchung").Range("d2").Value
    End Select
End If
End Sub

Ich möchte, dass, wenn ich in Zelle S6 einen Wert ändere, das ganze erneut durchgeführt wird.

Wie binde ich das ein? Vielen Dank!!!

Syrena

...zur Frage

Datum in Zelle darf nicht Zukünftiges Datum enthalten und muss im Aktuellen Jahr sein?

Hallo,

verzweifelt wende ich mich an das Internet da ich leider nicht weiss wie ich dieses Problem lösen kann. Folgende Idee... / Ich möchte in der Lage sein Spalte A1-A30 ein Datum zu geben das sich nur im Aktuellen Jahr befindet und nicht in der Zukunft liegen kann. Sollte dies der Fall sein soll eine Fehlermeldung Erscheinen mit einem von mir angegebenen Text... Ich habe bereits einen Code mit verschiedenen Funktionen wie Z.B das Zelle A1-A30 die Heute Funktion anwenden jedoch editierbar ist. Leider weiss ich nicht wie ich die o.g. 2 Sachen noch in den code einbinden kann oder wie dies Funktioniert. Ich hoffe ihr könnt mir helfen mit evtl den vollständigen Code? :)

Anbei der Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A3:A30")) Is Nothing Then
If Target.Value = "" Then Target.FormulaLocal = "=HEUTE()"
Else
If Intersect(Target, Range("D3:D30")) Is Nothing Then Exit Sub
If Target.Value = "" Then Target.Value = 1 End If End Sub

...zur Frage

Excel VBA Private Sub Worksheet_Change(ByVal Target As Range)? Help Programm vom Kollegen Bearbeitet

Habe für einen Kollegen ein Programm geschrieben. Das Problem ist nun das er vorher als Change Bedienung einen Befehl drin hat denn ich nicht ganz verstehe(und mein Programm Stört). :/ Der Code hat seinen Sinn deswegen möchte ich ihn gerne drin lassen. Hier der Code:

Private Sub Worksheet_Change(ByVal Target As Range)
   If Intersect(Target, Range("A7:A100")) Is Nothing Then Exit Sub
   If Target.Value <> "" Then
      Target.Offset(0, 8).Value = Date
   Else
      Target.Offset(0, 8).ClearContents
   End If

End Sub

Ich denke der Code Funktioniert so. Er Speichert in der Variable "Target" die Range A7;A100 und guck nun dann ob sie leer sind wenn ja soll er das Sub Verlassen. Ist das gebiet 0,8 nicht "ungleich" Leer soll es in die Zelle 0,8 bzw "Offset"? Das Datum reinschreiben. Ist Target 0,8 leer? Löscht es die Komplette Zeile?...

So das Programm erzeugt immer wenn man in Spalte A in eine neue Zeile schreibt an der stelle 8/bzw. H das Datum.

Das Problem ist aber das der Debugger anspringt wenn man Zeilen per Rechtsklick Zeilen Löschen rauslöscht. Und da das wiederum unschön ist wäre hilfe wirklich schön :)

mfg Dennis

...zur Frage

Excel-Code für Mehrfachauswahl in Dropdown-Listen?

Hallo zusammen,

Ich versuche gerade ein Excel-Dokument zu erstellen, bei dem eine Mehrfachauswahl aus Dropdown-Listen möglich ist. Das heißt aus einer Liste sollte es möglich sein mehrere Werte anzuwählen. Das habe ich auch mit dem untenstehenden VisualBasic-Code gemeistert. Allerdings habe ich erstens das Problem, dass auch eine Mehrfachauswahl des immer gleichen Wertes möglich ist. Theoretisch könnte also in einer Zelle x-mal derselbe Werte auftauchen. Dies soll natürlich nicht möglich sein. Bei Doppelauswahl desselben Wertes soll dieser aus der Zelle wieder verschwinden.

Mein zweites Problem ist, dass ich bislang nur 2 zwei Dropdown-Listen mit Mehrfachauswahl eingefügt bekomme. Sobald ich eine dritte Spalte versuche zu implementieren, bekomme ich eine Fehlermeldung für meinen Code.

Dadurch, dass ich mich mit dem Ganzen nicht so wirklich auskenne, wäre es sehr nett, wenn mir jemand helfen könnte.

Danke!

Bisheriger Code:

Private Sub Worksheet_Change(ByVal Target As Range)

** Mehrfachauswahl über DropDown-Liste

'** Einfügen im Code-Container des betreffenden Arbeitsblattes

'** Dimensionierung der Variablen

Dim rngDV As Range

Dim wert_old As String

Dim wertnew As String

'** Errorhandling

On Error GoTo Errorhandling

'** Mehrfachauswahl im definierten Bereich "Abteilungen" und "Themen" (Bsp. J2:J2000, I2:I2000) durchführen

If Not Application.Intersect(Target, Range("J2:J2000", "I2:I2000")) Is Nothing Then

'**Range definieren

Set rngDV = Target.SpecialCells(xlCellTypeAllValidation)

If rngDV Is Nothing Then GoTo Errorhandling

'** Prüfen, ob eine gültige Zelle ausgewählt wurde und Werte eintragen

If Not Application.Intersect(Target, rngDV) Is Nothing Then

Application.EnableEvents = False

wertnew = Target.Value

Application.Undo

wertold = Target.Value

Target.Value = wertnew

If wertold <> "" Then

If wertnew <> "" Then

Target.Value = wertold & ", " & wertnew

End If

Application.EnableEvents = True

End If

Errorhandling:

Application.EnableEvents = True

End Sub

...zur Frage

Ich benötige einen Makro, um ausgewählte Filter beim Schliessen zurück zu setzen. Aber mit dem Blattschutz funktioniert das nicht mehr. Kann mir jemand helfen?

Ich habe bisher diesen Makro benutzt:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim wksSheet As Worksheet
    For Each wksSheet In ThisWorkbook.Worksheets
        With wksSheet
            If .AutoFilterMode Then
                If .FilterMode Then
                    .ShowAllData
                End If
            End If
        End With
    Next wksSheet
    ThisWorkbook.Save
End Sub

...zur Frage

VBA | UserForm öffnen, sobald Excel-Zelle (die eine Formel enthält) = 2?

Hallo,

Excel-VBA....

ich benötige Hilfe beim Thema UserForm öffnen und ständige Abfrage.

Ich habe eine Zelle mit einer Formel, der Wert, welcher raus kommt soll verglichen werden und bei z.b höher als 2 soll eine User Form geöffnet werden.

Kann mir da wer helfen? Ich bin komplett auf dem Holzweg..

Der Code:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = "$T$6" Then
If UCase(Target.Value) > 2 Then NewUserForm.Show
End If

End Sub

Devo

...zur Frage

Excel if target.column?

Hallo zusammen,

habe mal wieder ein problem mit excel.... im nachfolgenden code geht alles soweit bis auf die zwei if cods bzw. der eine der sich auf die 4 ("D") Zeile bezieht geht. der code der auf zeile 9 gerichtet ist geht einfach nicht... wenn ich anstelle 9, 8 angebe und ändere gehts. es gehen alle spalten bis auf 8. dann is sense...

kann es sein, dass nur 8 zeilen irgendwie unterstützt werden oder hab ich da was falsch gemacht?

Option Explicit
Sub Worksheet_Change(ByVal Target As Range)
   
   If IsEmpty(Target) Then Exit Sub
   If Intersect(Target, Range("a2:h100")) _
      Is Nothing Then Exit Sub
   Application.EnableEvents = False
   On Error GoTo ERRORHANDLER
   Target = UCase(Target)
ERRORHANDLER:
   Application.EnableEvents = True

    If Target.Column = 4 Then Call Zelle11 ' Heim
    
    If Target.Column = 9 Then Call Zelle12 ' Gast
    
    
End Sub

...zur Frage

Excel vba Makro beim Blatt/Sheet wechsel?

Hallo zusammen

Ich würde gerne ein Makro ausführen, immer wenn ich das Tabellenblatt wechsle.

Also wenn ich bspw. von Tabelle1 in Tabelle2 wechsel, soll das Makro ausgeführt werden

Bis jetzt habe ich nur eine Möglichkeit gefunden, bei der bei jedem Zelleneintrag das Makroausgeführt wird. Das ist viel zu häufig und macht alles langsam. Super wäre es, wenn es erst beim WEchsel der Tabelle stattfindet.:

mein bisheriges:

Private Sub Worksheet_Change(ByVal Target As Range)

...zur Frage

Name + User?

Hallo,

was müsste ich hier anpassen? Ich komme mit der Fehler Meldung nicht zurecht.

Private Declare 36 GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Function GetNTUserA() As String
  
 Dim sBuffer As String
 Dim LSize As Long
 Dim user As String
  
 sBuffer = Space$(255)
 LSize = Len(sBuffer)
  
 Call GetUserName(sBuffer, LSize)
  
 If LSize > 0 Then
  user = Left$(sBuffer, LSize - 1)
 Else
  user = vbNullString
 End If
  
 GetNTUserA = user
  
End Function
Private Sub Worksheet_Change(ByVal Target As Range)
   
    If Target.Column = 6 Then
    Target.Offset(0, 11).Value = Date
  End If
      
    If Target.Column = 6 Then
    Target.Offset(0, 10).Value = GetNTUserA
  End If

End Sub

...zur Frage

Excel, Zellinhalte sollen automatisch nach unten "rutschen"

Hi,

ich versuche folgendes:

Eintrag in Zelle A10 soll automatisch in Zelle A11 eingetragen werden und jeder weitere Eintrag in A10 ebenso. Die bereits vorhanden Einträge sollen dabei nach unten verschoben werden. Das selbe will ich auch in der Spalte B, C, D... usw machen. Für die Spalte A hab ich es schon geschafft, allerdings bekomme ich für die weiteren Spalten nicht hin. Kann mir jemand helfen...wäre echt super....

Soweit bin ich schon:

Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo ErrorHandler

If Not Intersect(Target, Range("A1")) Is Nothing Then

Range("B65536").End(xlUp).Offset(1, 0).Value = Target.Value

Application.EnableEvents = False

Target.Value = ""

Target.Select

ErrorHandler:

Application.EnableEvents = True

End If

End Sub

...zur Frage

Excel VBA Selection begrenzen?

Hallo zusammen.

Ich komme leider beim meinem Problem nicht alleine weiter.

In meiner Tabelle werden in Spalte 2 und Zeile 4 Zeichen angezeigt, sobald ein Bereich selektiert wird. Die Zeichen sollen sich allerdings nur auf die Range J7:OJ57 beschränken, auch wenn die Selektion über die Range hinausgeht.

Denn jetzt, wenn ich z.B. eine Spalte markiere, schreibt der Code mir alle Zeichen in jede Zeile der Spalte, was fatal ist.

Kann ein Profi kurz helfen? :)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("J6:OJ57")) Is Nothing Then
Dim cell As Range
  Application.Calculation = xlCalculationManual
  Application.ScreenUpdating = False
  Application.EnableEvents = False
   Range("B6:B57").ClearContents
   Range("J4:OJ4").ClearContents
For Each cell In selection
  With cell
   Range(cell(.Row, 2), Cells(.Row, 2)) = ">>"
   Range(cell(4, .Column), Cells(4, .Column)) = "V"
  End With
Next
   Application.ScreenUpdating = True
   Application.EnableEvents = True
   Application.Calculation = xlCalculationAutomatic
End If
End Sub

...zur Frage

Was möchtest Du wissen?

Deine Frage stellen