|
Hi danke dir.
Mein Debugger sagt an der Stelle sm = .Cells(x, 11).Value zu mir unverträglich.
Weißt du was das bedeutet?
Ich habe den Code etwas geändert ingesamt. Die beiden Spalten in denen ich Duplikate suche sind I und M und die die ich aufaddieren möchte ist K.
Wäre dass dann so korrekt?
Option Explicit
Sub DatenvorbereitungRAGReporting()
Dim x As Long, c As Range, fc As String, sm As Double, flag As Boolean, z As Long
'_____________
'Ziel anpassen
With Sheets("Ausgabesheet")
On Error Resume Next
z = .Cells.Find("*", .Cells(1), -4123, 2, 1, 2, False).Row
On Error GoTo 0
End With
'_____________
'Quelle anpassen
With Sheets("Daten Stunden")
For x = .Cells.Find("*", .Cells(9), -4123, 2, 1, 2, False).Row To 1 Step -1
If .Cells(x, 9).Value <> "" Then
fc = .Cells(x, 9).Address: sm = .Cells(x, 11).Value: flag = False
Set c = .Columns(9).Find(.Cells(x, 9).Value, .Cells(x, 9), xlValues, xlWhole, 2, 1)
If Not c Is Nothing And c.Address <> fc Then
Do
If c.Offset(, 3) = .Cells(x, 13) Then
sm = sm + c.Offset(, 13).Value: flag = True
c.Resize(, 11).ClearContents
End If
Set c = .Columns(9).FindNext(c)
Loop While Not c Is Nothing And c.Address <> fc
End If
End If
If flag Then
.Cells(x, 11).Value = sm
z = z + 1
'_____________
'Ziel anpassen
.Cells(x, 9).Resize(, 11).Copy Sheets("Ausgabesheet").Cells(z, 9)
.Cells(x, 9).Resize(, 11).ClearContents
End If
flag = False
Next x
'_________
'wahlfrei
On Error GoTo Nix
For x = .Cells.Find("*", .Cells(1), -4123, 2, 1, 2, False).Row To 1 Step -1
If .Cells(x, 1).Value = "" Then .Rows(x).Delete
Next x
On Error GoTo 0
'_________
Nix:
End With
End Sub
|