Sortieren mit Prozentzahlen

Sub Linder_dat() Dim i As Long With Sheets("Alles") For i = .Cells(Rows.Count, "F").End(xlUp).Row To 2 Step -1 If .Cells(i, "F") Like "li" Then .Rows(i).Copy Sheets("Linder").Cells(Sheets("Linder").Cells(Rows.Count, "F").End( _ xlUp).Row + 1, "A") .Rows(i).Delete End If Next End With ActiveWorkbook.Save End Sub

Sub Fertige_weg() Dim i As Long With Sheets("Alles") For i = .Cells(Rows.Count, "K").End(xlUp).Row To 2 Step -1 If .Cells(i, "K") Like "100%" Then .Rows(i).Copy Sheets("Fertige").Cells(Sheets("Fertige").Cells(Rows.Count, "K").End(xlUp) _ .Row + 1, "A") .Rows(i).Delete End If Next End With ActiveWorkbook.Save End Sub

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Hi,
100% sind ja schlicht 1 - dann würde die Zeile heißen: if .cells(i,"K")=1
.cells erwartet "eigentlich" als zweiten Parameter eine Zahl; üblicherweise schreibt man dann z.B. .range("K" & i) oder meinetwegen .cells(i,6) - die 6. Spalte ist "F".
Weiterhin ist es Quatsch, bei jedem Schleifendurchlauf die unterste Zeile zu ermitteln. Das macht man einmal, dann kann man einfach hochzählen, also etwa:

Sub Fertige_weg()
Dim i As Long, uZ As Long
With Sheets("Fertige")
uZ = .Range("A" & .Rows.Count).End(xlUp) + 1 ' "A" oder "K" ?
End With
With Sheets("Alles")
For i = .Cells(Rows.Count, "K").End(xlUp).Row To 2 Step -1
If .Cells(i, "K") = 1 Then
.Rows(i).Copy Sheets("Fertige").Range("A" & uZ)
uZ = uZ + 1
.Rows(i).Delete
End If
Next
End With
ActiveWorkbook.Save
End Sub

Ansonsten würde ich Dir raten, Dich mit dem Autofilter zu befassen (Du setzt die zwei Kriterien, und das, was übrig bleibt, kannst Du in einem Rutsch kopieren) bzw. mit dem Sortieren, dann läuft das (bei größeren Datenmengen) deutlich schneller.
Schöne Grüße,
Michael
P.S.: z.B.

Sub oderSo()
Dim c As Range, uZ As Long, maxZ As Long
Dim nfS$ ' nächste, freie Spalte
nfS = "L" ' oder was es halt ist bei Dir
With Sheets("Fertige")
uZ = .Range("K" & .Rows.Count).End(xlUp).Row + 1 ' "A" oder "K" ?
End With
With Sheets("Alles")
maxZ = .Range("F1").CurrentRegion.Rows.Count
.Range(nfS & "2").Resize(maxZ - 1).FormulaLocal = "=WENNFEHLER((SUCHEN(""li"";F2)/(K2=1))>=1; _
ZEILE())"
.Range("F1").CurrentRegion.Sort key1:=.Range(nfS & "2"), order1:=xlAscending, Header:=xlYes
Set c = .Range(nfS & "2:" & nfS & maxZ).Find(True, LookIn:=xlValues, lookat:=xlWhole)
.Range(nfS & ":" & nfS).Delete
If Not c Is Nothing Then
.Rows(c.Row & ":" & maxZ).Copy Sheets("Fertige").Range("A" & uZ)
MsgBox "gleich werden alle anderen Zeilen gelöscht"
.Rows(c.Row & ":" & maxZ).Delete
Else
MsgBox "nix gefunden"
End If
End With
End Sub

Beliebteste Forumthreads (12 Monate)

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread