Excel Tabelle mit Änderungswerten füllen

J

josef24

Erfahrenes Mitglied
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

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
 
mann, ist das mal wieder ne miese Einrückung....

Das einzige was mir auf den ersten Blick auffällt:
If ausuf Then

"ausuf"?

Richtig geschrieben?
Wo kommt das her?
 
Sorry für die Gestaltung und der damit verbundenen Einrückung, ich kann`s nicht besser. Kann nur sagen das der Code schon mal funktioniert hat. Das Ganze hab ich aus dem Netz zusammengeschrieben. So kam auch der Satz "If ausuf Then" in den Code- Text. Bitte aber nochmals um Unterstützung. Gruß Josef
 
Also, der Code hat mal funktioniert - dann hast du Zeugs aus dem Netz dazukopiert, inklusive irgend welchen Variablen die du nicht kennst und nie befüllst. Ist ja klar das es nicht geht.
Nochmals: DU sollst nicht einfach blind Code zusammenkopieren, du musst auch verstehen was er macht, ansonsten wird das nie funktionieren.

Achja, Formatieren kannst du - du willst nicht. Genausowenig wir du deinen Code hier im Forum in VBA-Code Tags setzen willst.
Ich habe den Code schnell überflogen und entschieden, mir dieses Prachtstück nicht genauer anzusehen, da es unlesbar ist.
 
Um antworten zu können musst du eingeloggt sein.

Neue Beiträge

Zurück