Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 17:05:40
Zählen von Zeilen, in denen in bestimmten Bereich Daten sind
19.04.2024 16:34:52
gemeinsamer Filter über drei Spalten
19.04.2024 15:39:42
Exceltabelle daten per combobox zu word Datei
19.04.2024 14:04:05
PDF per VBA ausgeben - Seitenskalierung
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1480to1484
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1480to1484
1480to1484
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Changelog - optimieren/anpassen

Changelog - optimieren/anpassen
09.03.2016 15:51:18
Alex
Servus zusammen,
ich mal wieder ;)
Für mein VBA-Projekt soll ich jetzt noch ein "Changelog" anlegen.
Habe mir dazu einen Code aus dem Internet genommen und meinen Bedürfnissen soweit wie ich kann angepasst.
Was ich noch nicht hinbekommen habe:
- Code soll NUR anspringen, wenn Spalte B geändert wird
- Code soll NICHT anspringen, wenn ich eingaben in Userformen tätige, wirklich nur, wenn etwas in ein Excel Blatt (am besten nur Spalte B) geschrieben/gelöscht wird
- Es soll nicht nur die Zelle angezeigt werden, in der die Änderung stattfand, sondern auch in welchem Sheet.
Das sind meine 3 Knackpunkte noch.
Folgender Code liegt in Workbooks (Diese Arbeitsmappe):
Könnt ihn auch einfach kopieren, Arbeitsblatt "Changelog" anlegen und ausprobieren ;)
Dim vOldVal
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim bBold As Boolean
If Target.Cells.Count > 1 Then Exit Sub
On Error Resume Next
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
If IsEmpty(vOldVal) Then vOldVal = "Leere Zelle"
bBold = Target.HasFormula
With Sheets("Changelog")
.Unprotect Password:="Secret"
If .Range("A1") = vbNullString Then
.Range("A1:F1") = Array("Veränderte Zelle", "Alter Inhalt", _
"Neuer Inhalt", "Änderungszeit", "Änderungsdatum", "Benutzer")
End If
With .Cells(.Rows.Count, 1).End(xlUp)(2, 1)
.Value = Target.Address
.Offset(0, 1) = vOldVal
With .Offset(0, 2)
.Value = Target
.Font.Bold = bBold
End With
.Offset(0, 3) = Time
.Offset(0, 4) = Date
.Offset(0, 5) = Application.UserName
End With
.Cells.Columns.AutoFit
.Protect Password:="Secret"
End With
vOldVal = vbNullString
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
On Error GoTo 0
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
vOldVal = Target
End Sub
Danke für Hilfe!
Gruß Alex

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Changelog - optimieren/anpassen
09.03.2016 16:03:48
Alex
- Update -
Hey,
Problem:
- //ERLEDIGT// Code soll NUR anspringen, wenn Spalte B geändert wird
- //ERLEDIGT// Code soll NICHT anspringen, wenn ich eingaben in Userformen tätige, wirklich nur, wenn etwas in ein Excel Blatt (am besten nur Spalte B) geschrieben/gelöscht wird
- Es soll nicht nur die Zelle angezeigt werden, in der die Änderung stattfand, sondern auch in welchem Sheet.
Lösung war: If Not Intersect(Target, Range("B:B")) Is Nothing Then
Also nur noch 1 "Problem".
Aktualisierter Code:
Dim vOldVal
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim bBold As Boolean
If Target.Cells.Count > 1 Then Exit Sub
On Error Resume Next
If Not Intersect(Target, Range("B:B")) Is Nothing Then
Application.EnableEvents = False
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
If IsEmpty(vOldVal) Then vOldVal = "Leere Zelle"
bBold = Target.HasFormula
With Sheets("Changelog")
.Unprotect Password:="Secret"
If .Range("A1") = vbNullString Then
.Range("A1:F1") = Array("Veränderte Zelle", "Alter Inhalt", _
"Neuer Inhalt", "Änderungszeit", "Änderungsdatum", "Benutzer")
End If
With .Cells(.Rows.Count, 1).End(xlUp)(2, 1)
.Value = Target.Address
.Offset(0, 1) = vOldVal
With .Offset(0, 2)
.Value = Target
.Font.Bold = bBold
End With
.Offset(0, 3) = Time
.Offset(0, 4) = Date
.Offset(0, 5) = Application.UserName
End With
.Cells.Columns.AutoFit
.Protect Password:="Secret"
End With
vOldVal = vbNullString
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
On Error GoTo 0
End If
Application.EnableEvents = True
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
vOldVal = Target
End Sub
Gruß Alex

Anzeige
AW: Changelog - optimieren/anpassen
09.03.2016 16:17:48
Alex
Hallo,
schon fast peinlich, Lösung selber drauf gekommen.
Falls jemand mal einen Changelog braucht, bitte:

Dim vOldVal 'Must be at top of module
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim bBold As Boolean
If Target.Cells.Count > 1 Then Exit Sub
On Error Resume Next
If Not Intersect(Target, Range("B:B")) Is Nothing Then
Application.EnableEvents = False
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
If IsEmpty(vOldVal) Then vOldVal = "Leere Zelle"
bBold = Target.HasFormula
With Sheets("Changelog")
.Unprotect Password:="Secret"
If .Range("A1") = vbNullString Then
.Range("A1:G1") = Array("Veränderte Zelle", "Verändertes Arbeitsblatt", " _
Alter Inhalt", _
"Neuer Inhalt", "Änderungszeit", "Änderungsdatum", "Benutzer")
End If
With .Cells(.Rows.Count, 1).End(xlUp)(2, 1)
.Value = Target.Address
.Offset(0, 1) = Sh.name
.Offset(0, 2) = vOldVal
With .Offset(0, 3)
.Value = Target
.Font.Bold = bBold
End With
.Offset(0, 4) = Time
.Offset(0, 5) = Date
.Offset(0, 6) = Application.UserName
End With
.Cells.Columns.AutoFit
.Protect Password:="Secret"
End With
vOldVal = vbNullString
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
On Error GoTo 0
End If
Application.EnableEvents = True
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
vOldVal = Target
End Sub
Gruß Alex

Anzeige
laut Alex erledigt
09.03.2016 18:40:17
Michael
Hi Alex,
und das in nur einer halben Stunde - cool.
Abgesehen davon: statt des intersect kann man in diesem Fall kürzer und netter schreiben: 
If Target.Count > 1 or Target.Column  2 Then Exit Sub
Schöne Grüße,
Michael

AW: laut Alex erledigt
09.03.2016 23:06:40
Alexander
Hey Michael,
stimmt, ist einfacher + eleganter.
was mir gerade zu Hause gekommen ist:
Es gibt 1 Worksheet ("PM"), was auch nicht im Changelog auftauchen soll, wie realisiere ich das noch?
Leider das Programm nicht zur Hand.
Könnte das funktionieren?
If Target.Count > 1 or Target.Column  2 or sh.name = "PM" Then Exit Sub

Danke im Voraus!
Gruß Alex

Anzeige
sollte passen
10.03.2016 15:57:17
Michael
Hi Alex,
ich würde sagen: ja.
Schöne Grüße,
Michael
P.S.: @Werner: ich kann den Link in dem Zusammenhang nicht ganz nachvollziehen.

AW: sollte passen
10.03.2016 17:07:16
Alexander
Hey,
habs getestet, funktioniert alles wie gewünscht :)
Ich denke mal, wollte mir auf die Möglichkeit das gleiche mit Select Case zu realisieren hinweisen?!
Gruß Alex

AW: sollte passen
11.03.2016 12:03:47
Alex
Hallo,
der Changelog funktioniert wie gewollt, solange ich "per Hand" was eintrage und lösche.
Im fertigen Zustand kann ich aber nur über userformen Eintrage hinzufügen oder löschen.
Wenn ich einen Eintrag hinzufüge, erkennt der Changelog das und erfasst es.
Wenn ich aber über eine Useform etwas lösche, erfasst er das nicht, woran kann das liegen?
Gruß Alex

Anzeige
nicht nachvollziehbar
11.03.2016 12:23:55
Michael
Hi Alex,
müßte eigentlich trotzdem gehen, sofern Du im Code der Userform nicht die Events abschaltest.
Ansonsten "weißt" Du bzw. das Programm ja, was Du wo schreibst, also kannst Du im gleichen Zug, in dem Du einen Wert schreibst, auch einen Eintrag im Log machen.
Hm, ich hab mal ne Minimalversion getestet: 
Private Sub CommandButton1_Click()
Range("A1") = Time
End Sub
Private Sub CommandButton2_Click()
Range("A1") = ""
End Sub
In beiden Fällen wird das 
Private Sub Worksheet_Change(ByVal Target As Range)
MsgBox Target.Address
End Sub
'bzw. in "Diese Arbeitsmappe"
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
MsgBox Sh.Name & Target.Address
End Sub

ausgelöst.
Schöne Grüße,
Michael

Anzeige
AW: nicht nachvollziehbar
15.03.2016 09:18:52
Alex
Hallo Michael,
dann scheint es wohl an den abgeschalteten Events zu liegen :(
Wenn ich die Events = True setze, hängt sich der Changelog auf...
Habe schon etwas rumgebastelt, aber keine Ahnung Warum/Wo der Code sich dann aufhängt.
Dim vOldVal
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim bBold As Boolean
If Target.Cells.Count > 1 Then Exit Sub
On Error Resume Next
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
If IsEmpty(vOldVal) Then vOldVal = "Leere Zelle"
bBold = Target.HasFormula
With Sheets("Changelog")
.Unprotect Password:="Secret"
If .Range("A1") = vbNullString Then
.Range("A1:F1") = Array("Veränderte Zelle", "Alter Inhalt", _
"Neuer Inhalt", "Änderungszeit", "Änderungsdatum", "Benutzer")
End If
With .Cells(.Rows.Count, 1).End(xlUp)(2, 1)
.Value = Target.Address
.Offset(0, 1) = vOldVal
With .Offset(0, 2)
.Value = Target
.Font.Bold = bBold
End With
.Offset(0, 3) = Time
.Offset(0, 4) = Date
.Offset(0, 5) = Application.UserName
End With
.Cells.Columns.AutoFit
.Protect Password:="Secret"
End With
vOldVal = vbNullString
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
On Error GoTo 0
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
vOldVal = Target
End Sub
Gruß+Danke!
Alex

Anzeige
AW: nicht nachvollziehbar
15.03.2016 09:31:08
Alex
Hey Michael,
ignoriere die andere Antwort einfach, war noch nicht wieder drinnen..
Ich hab hier mal die Löschfunktion + wichtige Unterfunktion.
Vielleicht fällt dir sofort ja auf, warum das "löschen" nicht geloggt wird.
Private Sub CommandButton2_Click() 'löschen
Dim rng As Range
Dim strfrage As String
Dim lngZeile As Long                   'funktion
Dim lngspalte As Long                  'funktion
Dim ausgangsZelle As String            'funktion
Dim nächsteZelle As String             'funktion
'Übergabeparameter an Neu-Nummerierung
Dim iZeile As Long
Dim sKeyAlt As String
strfrage = " - wirklich entfernen?"
With ListBox1
If .Selected(.ListIndex) = True Then
If MsgBox( _
prompt:="Wollen Sie den Eintrag - " & Auswahllistbox1 & strfrage, _
Buttons:=vbYesNo + vbQuestion _
) = vbYes Then
Unload Me
Set rng = Sheets(Kategorie).Cells.Find(What:=Auswahllistbox1, after:=ActiveCell, _
LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
lngspalte = rng.Column                              'funktion
lngZeile = rng.Row                                  'funktion
iZeile = lngZeile       'Zeilen# gelöschter Key
sKeyAlt = rng.Offset(0, -1)    'gelöschter Key
lngspalte = lngspalte - 1                           'funktion
ausgangsZelle = Cells(lngZeile, lngspalte).Value    'funktion
Do                                                  'funktion
Cells(lngZeile, 1).EntireRow.Delete                 'funktion
lngezeile = lngZeile + 1                            'funktion
nächsteZelle = Cells(lngZeile, 1).Value             'funktion
Loop Until Len(ausgangsZelle) = Len(nächsteZelle) Or Cells(lngZeile, 1).Value =  _
"" 'funktion
End If
End If
End With
Call Neu_Nummerierung(Kategorie, iZeile, sKeyAlt)   'nachfolgende Keys anpassen
End Sub


Sub Neu_Nummerierung(Kategorie As String, ZeilenNr As Long, sKeyOld)
With Worksheets(Kategorie)
'Initialisierung
LoL = .Cells(Rows.Count, "A").End(xlUp).Row         'Zeilen# der letzten Eintragung
nArr = LoL - iAnzahl + 1                            'max. Anzahl Zeilen des Arrays
sKeyNext = ""                                       'Ergebnis - der angepasste Key
'Strukturdaten aus gelöschtem Key ableiten
sKey = sKeyOld                                      'der gelöschte Key
a1 = 0                                              'erste Zeile im Array
Call Split_Nummer                                   'splitte Key auf in Zahlen
'auf Basis der Strukturdaten alle der Struktur entsprechenden folgenden Keys in arr  _
speichern
For z = ZeilenNr To LoL                     'maximla Umfang: Position gelöschte Zeile  _
bis zum Ende
sKey = .Range("A" & z)                  'aktueller Key
a1 = a1 + 1                             'nächster Index 1 im Array
Call Split_Nummer                       'speichere Key in Array
If swF = True Then Exit For             'alle zutreffenden Keys wurden in Array  _
gespeichert
Next z
'Nummern anpassen
i = iVAnzahl + 1                            'position der anzupassenden Zahl in den  _
Keys
For a1 = 1 To na                            'alle diese Ausdrücke im Array werden verä _
ndert, indem
arr(a1, i) = arr(a1, i) - 1                 'die Zahl an dieser Position um 1  _
vermindert wird
Next
'Keys in Tabelle ausgeben
z = ZeilenNr                                'Position des gelöschten Keys = 1. Position  _
der folgenden Keys
Application.ScreenUpdating = False
For a1 = 1 To na
sKeyNext = "'"                          'angepasste Keys als Text speichern
For i = 1 To arr(a1, 0)
sKeyNext = sKeyNext & arr(a1, i) & IIf(i
Gruß+Danke Alex!

Anzeige
AW: nicht nachvollziehbar
15.03.2016 15:12:09
Michael
Hi Alex,
der Code ist zu unübersichtlich, als daß ich ihn im Einzelnen nachvollziehen möchte: die untere sub enthält keine einzige Variablendeklaration.
Bitte setze an den Anfang jedes Moduls das "option explicit", Dimme die Variabeln sauber, und dann wirst Du Fehler selbst besser finden können.
Unklar ist, was Kategorie in 
Set rng = Sheets(Kategorie).Cells.Find

ist: das "interne" Blatt-OBJEKT oder ein global definierter Name Kategorie="Kategorie"...
Im ersten Falls kannst Du das Sheets weglassen und schreiben 
Set rng = Kategorie.Cells.Find

ABER dann ist Kategorie eben ein OBJEKT und kein String (wie Du ihn an Neu_Nummerierung übergibst).
Ohne Beispieldatei und option explicit ist das alles ein Ratespiel...
Eine Möglichkeit fürs Log wäre aber, nach der Zeile 
Cells(lngZeile, 1).EntireRow.Delete

sinngemäß einzufügen: schreibeInsLog("Zeile " & lngZeile & " vom Makro gelöscht")
Schöne Grüße,
Michael
Anzeige

Links zu Excel-Dialogen

CommandButton ListBox

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige