nochmal optimiert.
01.04.2010 18:21:29
Tino
Hallo,
so funktioniert es besser.
Sub Loeschen_Mit_Formel()
Dim oSH As Worksheet, iCalc As Integer
Dim sFormel$, i As Integer
Dim MaxCol As Long, MinCol As Long
Dim sLeer As String
Set oSH = Sheets("Tabelle1") 'Tabelle anpassen
With Application
iCalc = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
With oSH.UsedRange
MinCol = .Cells(1, 1).Column
With .Columns(.Columns.Count).Offset(0, 1)
MaxCol = .Column - 1
MaxCol = Application.WorksheetFunction.Min(26, MaxCol)
For i = MinCol To MaxCol
sFormel = sFormel & "IF(RC" & i & "="""",""|"",RC" & i & ")&"
Next i
sFormel = "=" & Left$(sFormel, Len(sFormel) - 1)
sLeer = String(MaxCol - MinCol + 1, "|")
.FormulaR1C1 = sFormel
'entsprechende Formel
.Offset(0, 1).FormulaR1C1 = _
"=IF((COUNTIF(R" & .Cells(1, 1).Row & "C[-1]:RC[-1],RC[-1])>1)*(RC[-1]<>""" & sLeer & """),TRUE,ROW())"
'sortieren, Tabelle ist mit Überschrift
oSH.UsedRange.Sort Key1:=.Offset(0, 1).Cells(1, 1), Order1:=xlAscending, Header:=xlYes
On Error Resume Next
.Offset(0, 1).SpecialCells(xlCellTypeFormulas, 4).EntireRow.Delete
.Offset(0, 1).EntireColumn.Delete
.EntireColumn.Delete
On Error GoTo 0
End With
End With
.ScreenUpdating = True
.Calculation = iCalc
End With
End Sub
Gruß Tino