' **********************************************************************
' Modul: Module1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub delDouble()
Dim lngLast As Long
On Error GoTo ErrExit
tranquilize
With ActiveSheet
lngLast = .Cells(.Rows.Count, 1).End(xlUp).Row
.Columns(1).Insert
.Cells(1, 1) = "Temp"
.Cells(2, 1).FormulaArray = "=(D2=MAX(IF(($B$2:$B$" & lngLast & "=B2)*($C$2:$C$" & lngLast & "=C2),$D$2:$D$" & lngLast & ")))*1"
.Range(.Cells(2, 1), .Cells(lngLast, 1)).FillDown
.Calculate
.Range(.Cells(2, 1), .Cells(lngLast, 1)) = .Range(.Cells(2, 1), .Cells(lngLast, 1)).Value
.Range("A1").CurrentRegion.AutoFilter Field:=1, Criteria1:="0"
.Range("A2:A" & lngLast).SpecialCells(xlCellTypeVisible).EntireRow.Delete
.Range("A1").CurrentRegion.AutoFilter
.Columns(1).Delete
End With
ErrExit:
tranquilize True
End Sub
Public Sub tranquilize(Optional ByVal Modus As Boolean = False)
Static lngCalc As Long
With Application
.ScreenUpdating = Modus
.EnableEvents = Modus
.DisplayAlerts = Modus
.EnableCancelKey = IIf(Modus, 1, 0)
If Not Modus Then lngCalc = .Calculation
If Modus And lngCalc = 0 Then lngCalc = -4105
.Calculation = IIf(Modus, lngCalc, -4135)
.Cursor = IIf(Modus, -4143, 2)
End With
If Modus Then
With Err
If .Number <> 0 Then
MsgBox IIf(Erl, vbLf & "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
"Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbLf & _
.Description, vbExclamation, "Fehler"
End If
.Clear
End With
End If
End Sub