Excel & VBA-Kopieren von Zeilen in eine neue Tabelle basierend auf dem Wert der Zelle

Ich bin ein totaler Anfänger in Excel und VBA.
Ich habe ein Blatt wie dieses:

A        B        C         D
someinfo someinfo someinfo OK
someinfo someinfo someinfo OK
someinfo someinfo someinfo ERROR
someinfo someinfo someinfo ERROR
someinfo someinfo someinfo OK
someinfo someinfo someinfo OK
someinfo someinfo someinfo ERROR
someinfo someinfo someinfo ERROR

Ok, würde ich mag, um kopieren Sie die "OK" - Zeilen in ein neues Blatt und das mit dem "FEHLER" in einem anderen.

Wie kann ich das tun?

  • Einfachste Möglichkeit wäre die Verwendung von filtern und filtern nur für OK, dann copy/paste, dann filter für ERROR, dann copy/paste. Wenn Sie das tun, während Sie ein makro aufzeichnen, werden Sie 90% der Weg in eine VBA-Lösung
  • Diese beantwortet waren, wurde unzählige Male auf dieser Sie sicher, verwenden Sie die Suche vor dem posten. Sie können auch überprüfen Sie meine Antworten, ich antwortete auf eine ähnliche Frage heute früh.
  • Sorry, ich Suche über stackoverflow, aber ich wohl nicht finden, das Thema, das Sie sich beziehen.
InformationsquelleAutor net.cat | 2013-06-12
  1. 3

    Wie bereits in früheren Kommentaren ist dies, wie würden Sie Filter~>Kopieren von~>Einfügen

    Sub FilterAndCopy()

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual


Dim lngLastRow As Long
Dim OKSheet As Worksheet, ErrorSheet As Worksheet

Set OKSheet = Sheets("Sheet2") ' Set This to the Sheet name you want all Ok's going to
Set ErrorSheet = Sheets("Sheet3") ' Set this to the Sheet name you want all Error's going to

lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row


With Range("A1", "D" & lngLastRow)
    .AutoFilter
    .AutoFilter Field:=4, Criteria1:="OK"
    .Copy OKSheet.Range("A1")
    .AutoFilter Field:=4, Criteria1:="ERROR"
    .Copy ErrorSheet.Range("A1")
    .AutoFilter
End With


Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

End Sub
    • Dies wird ausgeführt, es kopiert nur die erste Zeile, wahrscheinlich, weil Sie auf OK, und Fehler sind die Ergebnisse einer Funktion, die jede Zeile analysieren
    • Dass hsouldn egal, wie lange die Zellen halten den Wert Ok oder Fehler. Es könnte sein, weil ich Spalte A als Referenz für das finden der letzten Zeile der Daten, wenn Sie NICHT mit Spalte A oder gibt es eine chance, dass Spalte A keine Werte, die alle den Weg auf den Boden, dann müssen Sie möglicherweise ändern Sie die Zeile lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row würden Sie die "A" zu welcher Spalte enthält Ihre Letzte Zeile der Daten. Ich habe getestet, mein code selbst mit Ihren genauen Daten. Es hat für mich gearbeitet.
    InformationsquelleAutor user2140261
  2. 2

    Probieren Sie etwas wie dieses...

    Set sh = ThisWorkbook.Sheets("Sheet1")
Set sh2 = ThisWorkbook.Sheets("Sheet2")
Set sh3 = ThisWorkbook.Sheets("Sheet3")
lastrow = sh.Cells(Rows.Count, "A").End(xlUp).row
R = 2 
Do While R <= lastrow
     If sh.Range("D" & R) = "OK" Then
         sh.Range("A" & R & ":D" & R).Copy _
         Destination:=sh2.Range("A" & R)
     Else
         sh.Range("A" & R & ":D" & R).Copy _
         Destination:=sh3.Range("A" & R)
     End IF
Loop

    Müssen Sie ändern Sie die Zeilen/Spalten die Daten herkommen, um Ihre Bedürfnisse anzupassen, sondern ich schrieb, basierend auf deinem Beispiel.

    EDIT:
    Am zweiten Gedanken, ich habe einige Lesen über Filter und ich gehe mit, was die anderen hier gepostet haben.

    • Dies würde dazu führen, eine Endlose Schleife, Sie sind nicht Inkrementieren R. So R wird IMMER weniger werden, dann lastrow. Ich denke, Sie ment zu verwenden For R = 2 to lastrow und ersetzen Loop with Next R. Auch bei Ihnen ist Viel langsamer. Ich lief sowohl unseren code über 10.000 Zeilen 5 mal jede Mine hatte eine avergage Zeit von 0.615133072755998, während Ihnen hatte eine Durchschnittliche Zeit von 16.982829004747300. Das ist FAST 28-Mal langsamer, dann von mir.
    • Ich vergaß hinzuzufügen, R = R + 1. Aber du hast vollkommen Recht. Ich bin auch ein Neuling in excel, aber ich war auf einige code arbeiten, wo ich das problem auf diese Weise. Filter sind der Weg zu gehen, obwohl, und ich werde ihn in Erinnerung behalten.
    • Es ist in Ordnung ich bin immer noch lernen jeden Tag auch. Ich habe nur diese Frage beantwortet haben, weil ich IHRE Frage beantwortet heute früh eine fast identische Antwort, und dachte, vielleicht haben Sie übersehen, dass die Antwort so wiederholte ich es hier.
    • Habe ich Durcheinander bekommen. Danke (wieder) für die Hilfe!
    InformationsquelleAutor Al.Sal
Schreibe einen Kommentar