Problem gelöst
07.07.2009 16:16:28
Christoph
Ok. Ich hab's eingesehen.
Falls jemanden meine Fuckel-Lösung interessiert: Hier ist Sie für's Archiv:
Es werden zwar relativ viele Daten bewegt, man ist aber in ein paar Sekunden damit durch. Bei sämtlich Varianten die ich mit For...Next und anderen Schleifen probiert habe, lief das Makro mehrere Minuten!
Vielen Dank an Lars für die geduldige Hilfe.
Gruß
Christoph
' Nullzellen entfernen
Dim Nullzellen As Integer
Dim Ver2_genZei As Integer
Ver2_genZei = 2000
Range("E2:H" & Ver2_genZei).FormulaR1C1 = "=IF(LEN(RC[-4])>0,2,1)"
Columns("E:H").Copy
Columns("E:H").PasteSpecial Paste:=xlPasteValues
Columns("A:H").Sort Key1:=Range("E1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Nullzellen = [COUNTIF(E:E,"1")]
If Nullzellen > 0 Then
Range("A2:A" & (Nullzellen + 1)).Delete Shift:=xlUp
End If
Columns("A:H").Sort Key1:=Range("F1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Nullzellen = [COUNTIF(F:F,"1")]
If Nullzellen > 0 Then
Range("B2:B" & (Nullzellen + 1)).Delete Shift:=xlUp
End If
Columns("A:H").Sort Key1:=Range("G1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Nullzellen = [COUNTIF(G:G,"1")]
If Nullzellen > 0 Then
Range("C2:C" & (Nullzellen + 1)).Delete Shift:=xlUp
End If
Columns("A:H").Sort Key1:=Range("H1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Nullzellen = [COUNTIF(H:H,"1")]
If Nullzellen > 0 Then
Range("D2:D" & (Nullzellen + 1)).Delete Shift:=xlUp
End If
Columns("E:H").ClearContents
' SPalten A:D aufsteigend sortieren.
Columns("A:A").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
If Range("A2") = 0 Then
Range("A2").Delete Shift:=xlUp
End If
Columns("B:B").Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
If Range("B2") = 0 Then
Range("B2").Delete Shift:=xlUp
End If
Columns("C:C").Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
If Range("C2") = 0 Then
Range("C2").Delete Shift:=xlUp
End If
Columns("D:D").Sort Key1:=Range("D1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
If Range("D2") = 0 Then
Range("D2").Delete Shift:=xlUp
End If