mit den Nullen ist kein Problem, man bekommt es mit einer IF Abfrage geregelt.
Das hier:
Zitat:...bleibt noch die Hürde mit dem Markieren addierter Zahlenwerte die beide höher Null waren.
verstehe ich nicht ganz.
Wenn Du es so meinst, dass die Zeilen in die aufsummiert wurden, kenntlich gemacht werden, dann lass mal folgenden Code laufen und schau Dir die neue letzte Spalte an.
Diese Spalte nach eins Filtern, dann hast Du die Zeilen.
Die Fehlermeldung kann ich nicht nachvollziehen. Bei mir tritt kein Fehler ein.
Hattest Du den zuletzt eingestellten Code genutzt?
Jetzt teste folgenden Code, tritt der Fehler wieder auf?
Code:
Option Explicit
Sub Löschen()
Dim i As Long, j As Long
Dim lngS As Long ' die letzte belegte Spalte in Zeile 4
Dim lngZ As Long ' die letzte belegte Zeile in Spalte A
Dim dblS As Double
On Error GoTo Ende
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For i = 5 To lngZ
If Cells(i, lngS + 2) > 1 Then
If .Cells(i, 1) = .Cells(i + 1, 1) Then
For j = 2 To lngS
dblS = Application.WorksheetFunction.Sum(.Range(.Cells(i, j), .Cells(i + .Cells(i, lngS + 2) - 1, j)))
If dblS > 0 Then
.Cells(i, j) = dblS
.Cells(i, lngS + 1) = 1
End If
Next j
End If
End If
Next i
.Range(Cells(4, 1), .Cells(lngZ, lngS)).RemoveDuplicates Columns:=1, Header:=xlYes
.Columns(lngS + 2).Clear
End With
Ende:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
If Err Then MsgBox "Fehler: " & Err.Number & vbLf & vbLf & Err.Description
End Sub
Moin Frank,
danke für die *.xlsx.Bei der Gelegenheit: Gestern Abend hatte ich den zweiten Kunden, der mit Locky Bekanntschaft machte … :22:
Ich bin heute ziemlich in Zeitnot, darum habe ich den Code nur überflogen. So stümperhaft ist der doch gar nicht! Die Routine kommt von alleine. - Im Anhang eine Auswertung mit Power Query und Pivot, also ohne VBA (obwohl ich VBA-Fan bin). Wenn ich dich richtig verstanden habe, sollte das in etwa so aussehen. Eventuelle Rückfragen wahrscheinlich erst später am heutigen Tage ...
Beste Grüße Günther
Excel-ist-sexy.de …schau doch mal rein! Der Sicherheit meiner Daten wegen lade ich keine *.xlsm bzw. *.xlsb- Files mehr herunter! -> So geht's ohne!
dank dir nochmal für die Hinweise und den Einsatz.
Dann kreuze ich mal die Finger,
auf das und Locky uns erspart bleibt.
Vielleicht muss ich mich mal mehr mit Pivot beschäftigen.
Den Vorteil den ich sehe:
Alle Einträge bleiben erhalten.
Ich kann also alle Werte im nachhinein Kontrollieren und Gegenprüfen.
Aber wie befürchtet ist die Tabelle um ein vielfaches größer (KB)
Und schon bei meiner Größe bekommen ich gelegentlich Probleme beim scrollen. (Zeitraffer :22: )
Ich steig da nicht ganz durch
Es kommt mir so unübersichtlich vor.
Und meine Formatierung scheint in der Pivot Anzeige auch einige Abweichungen zu bewirken.
(Zeilen Höhe ist unterschiedlich)
Vielleicht sollte ich mal an einem Pivot Kurs teilnehmen.
Dim i As Long, j As Long
Dim lngS As Long ' die letzte belegte Spalte in Zeile 4
Dim lngZ As Long ' die letzte belegte Zeile in Spalte A
Dim dblS As Double
On Error GoTo Ende
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Viele Werte gehen verloren
Es scheint als würden nur Werte addiert mit Zahlen größer Null
Siehe Bild(oben=vorher; unten=nachher)
Die Markierten werte sind in der Summe nicht mehr vorhanden.
&
Die richtigen Zeilen sind nun durch die Einser an den Rand der Tabelle gerutscht,
jedoch kann ich später nicht mehr wissen welcher der vielen Werte in einer Zeile einer Überprüfung bedürfen.
Es müsste also zusätzlich genau jener Wert (In unserem Beispiel die Zweier) irgenwie kenntlich gemacht werden.
Dim i As Long, j As Long
Dim lngS As Long ' die letzte belegte Spalte in Zeile 4
Dim lngZ As Long ' die letzte belegte Zeile in Spalte A
Dim dblS As Double
On Error GoTo Ende
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
