Hallo in die Runde, habe mal wieder eine Frage zu EXCEL VBA Code bezüglich Änderungen dokumentieren.
Ich habe eine Tabelle die ich befülle, wo Werte "formatiert" werden und eine Tabelle "Info" mit Änderungen gespeichert werden sollen.
Ich habe die Tabelle formatiert um Tabellenanteile auszuwählen und per Outlook dann zu versenden.
Nachdem ich diese Änderungen angefügt habe, werden die Änderungen nicht mehr in die Tabelle "INFO" gespeichert.
Ich füge mal diesen Code in der Hoffnung an, das mir bei der Fehlersuche jemand helfen kann. Vielen Dank schon mal. Gruß Josef
Ich habe eine Tabelle die ich befülle, wo Werte "formatiert" werden und eine Tabelle "Info" mit Änderungen gespeichert werden sollen.
Ich habe die Tabelle formatiert um Tabellenanteile auszuwählen und per Outlook dann zu versenden.
Nachdem ich diese Änderungen angefügt habe, werden die Änderungen nicht mehr in die Tabelle "INFO" gespeichert.
Ich füge mal diesen Code in der Hoffnung an, das mir bei der Fehlersuche jemand helfen kann. Vielen Dank schon mal. Gruß Josef
Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo errorhandler
Dim wks As Worksheet
Dim lngLast As Long
Dim irow As Long
Dim lngZeileMax As Long
Dim rngZelle As Range ' Objekt ' Integer 'Range ' Integer ' Long
Dim von As Long
Dim tempwert
Dim i As Integer
Application.EnableEvents = True
If inarbeit = True Then Exit Sub
If Not Intersect(Target, Range("A2:AE500")) Is Nothing Then
inarbeit = True
irow = Cells(Rows.Count, 1).End(xlUp).Row
Cells(irow, "G").NumberFormat = "General"
Cells(irow, "O").NumberFormat = "General"
Cells(irow, "W").NumberFormat = "General"
Cells(irow, "G").FormulaLocal = "=WENN($H" & irow & "<>"""";INDEX(PLZ!$A:$A;VERGLEICH($H" & irow & ";PLZ!$C:$C;0));"""")"
Cells(irow, "O").FormulaLocal = "=WENN(UND(M" & irow & "<>""p"";M" & irow & "<>""sz"";M" & irow & "<>"""");M" & irow & "-HEUTE();"""")"
Cells(irow, "P").FormulaLocal = "=WENN(J" & irow & "="""";"""";DATEDIF(J" & irow & ";HEUTE();""Y""))"
Cells(irow, "Q").FormulaLocal = "=WENN(K" & irow & "="""";"""";DATEDIF(K" & irow & ";HEUTE();""Y""))"
Cells(irow, "R").FormulaLocal = "=WENN($H" & irow & "<>"""";INDEX(PLZ!$B:$B;VERGLEICH($H" & irow & ";PLZ!$C:$C;0));"""")"
Cells(irow, "Y").FormulaLocal = "=WENN($N" & irow & "="""";"""";WENN($N" & irow & "<10;""WG"";WENN(UND($N" & irow & ">=15;$N" & irow & "<=18);""TG"";"""")))"
Cells(irow, "Z").FormulaLocal = "=WENN($Y" & irow & "=""TG"";""42,00 € "";WENN($Y" & irow & "=""WG"";""84,00 € "";WENN($Y" & irow & "="""";"" "")))"
Cells(irow, "AB").FormulaLocal = "=WENN(M" & irow & "="""";"""";TEXT(M" & irow & ";""JJJJ.MM.TT""))"
Cells(irow, "AC").FormulaLocal = "=Wenn(J" & irow & "="""";"""";TEXT(J" & irow & ";""MM.TT""))"
Cells(irow, "AD").FormulaLocal = "=WENN($J" & irow & "<>"" "";BRTEILJAHRE($J" & irow & ";HEUTE()))"
Cells(irow, "AE").FormulaLocal = "=WENN($AD" & irow & "<>"" "";AUFRUNDEN($AD" & irow & ";0);"" "")"
For i = 2 To Cells(Rows.CountLarge, 14).End(xlUp).Row ' Bis letzte Zeile automatisch ausführen
If Cells(i, 14).Value <= 10 Then ' Wenn in den Zeilen der Spalte 21 ein "<= 10" steht
Cells(i, 22) = "20€" ' dann soll in der Spalte 22 die "20€" eingefüht werden
Cells(i, 23).Value = " "
End If
Next
inarbeit = False
End If
'** WENN der folgende Code eigenständig gestartet wird wir die Tabelle "Info" korrekt mit Daten Alt und Neu
'** gefüllt!
If Not ausuf Then
inarbeit = False
tempwert = Target.Value
Application.Undo
mvntWert = Target.Value
Target = tempwert
inarbeit = True
End If
Dim wks As Worksheet
Dim lngLast As Long
Set wks = Worksheets("Info")
lngLast = wks.Range("A65536").End(xlUp).Row + 1
If Target.Count > 1 Then Exit Sub
If Intersect(Range("A2:AE320"), Target) Is Nothing Then Exit Sub
With wks
.Range("A" & lngLast).Value = Target.Address(0, 0)
.Range("B" & lngLast).Value = Tabelle1.Range("B" & Target.Row).Value
.Range("C" & lngLast).Value = mvntWert
.Range("D" & lngLast).Value = Target.Value
.Range("E" & lngLast).Value = VBA.Environ("Username")
.Range("F" & lngLast).Value = Now
mvntWert = ""
' *** Ab hier wird die Tabelle Info aktualisiert,
' *** aber nur wenn ein Datensatz geändert wird.
' *** Ansosten keine Änderung
Dim lngZeile As Long, zielspalte As Long ' , With as variable
zielspalte = 7
With Info
lngZeileMax = .Cells(.Rows.Count, 7).End(xlUp).Row 'Hier Änderung von "zielspalte" auf "1" Spalte A
For lngZeile = lngZeileMax To 2 Step -1
.Cells(lngZeile, zielspalte).FormulaLocal = "=WENN(F" & lngZeile & "="""";"""";DATEDIF(F" & lngZeile & ";HEUTE();""D""))"
If .Cells(lngZeile, zielspalte) >= 3 Then .Rows(lngZeile).Delete ' Löscht Daten älter 3 Tage
Next
End With
End With
Exit Sub
errorhandler:
Exit Sub
End Sub