Excel-Ausdruck zum kopieren von Zeilen, aber entfernen Sie leere Zeilen

Brauche ich zum kopieren von Daten aus einem Arbeitsblatt in ein anderes. Allerdings brauche ich eine bedingte Kopiervorgang, der überspringt Zeilen, die auf bestimmten Kriterien basiert.

Zum Beispiel, wenn ich starten mit...

Active  Value
yes     1
no      2
no      3
yes     4
no      5
no      6

Ich will nur zum kopieren von Zeilen, die Aktiv=ja, so würde ich am Ende mit...

Value
1
4

Kann mir jemand zeigen, wie dies mit 1) ein makro und 2) eine Formel?

  • Ein makro kopieren können, eine ganze Zeile, eine einzige Formel nicht.
  • siehe auch meine aktualisierte Antwort mit Formel-Ansatz
InformationsquelleAutor John Livermore | 2014-04-11
  1. 5

    Formel-Ansatz:

    angenommen, deine Daten stehen in Tabelle1, range A2:B7.

    Verwenden Sie dann diese Formel in Blatt2 Zelle A2:

    =IFERROR(INDEX(Sheet1!B:B,SMALL(IF(Sheet1!$A$2:$A$7="yes",ROW(Sheet1!$A$2:$A$7)),ROW()-ROW($A$2)+1)),"")

    mit array-Eintrag (STRG+SHIFT+ENTER) und ziehen Sie es nach unten.

    Excel-Ausdruck zum kopieren von Zeilen, aber entfernen Sie leere Zeilen

    VBA-Ansatz:

    Können Sie AutoFilter:

    Sub test()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim rng As Range, rngToCopy As Range
    Dim lastrow As Long
    'change Sheet1 and Sheet2 to suit
    Set ws1 = ThisWorkbook.Worksheets("Sheet1")
    Set ws2 = ThisWorkbook.Worksheets("Sheet2")

    With ws1
        'assumung that your data stored in column A:B, Sheet1
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set rng = .Range("A1:B" & lastrow)
        'clear all filters
        .AutoFilterMode = False
        With rng
            'apply filter
            .AutoFilter Field:=1, Criteria1:="yes"
            On Error Resume Next
            'get only visible rows
            Set rngToCopy = .SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
        End With
        'copy range
        If Not rngToCopy Is Nothing Then rngToCopy.Copy Destination:=ws2.Range("A1")
        'clear all filters
        .AutoFilterMode = False
    End With
    Application.CutCopyMode = False
End Sub

    Excel-Ausdruck zum kopieren von Zeilen, aber entfernen Sie leere Zeilen

    Beachten Sie, wenn Sie möchten, kopieren Sie nur Value Spalte, ändern

    Set rngToCopy = .SpecialCells(xlCellTypeVisible)

    zu

    Set rngToCopy = .Offset(, 1).Resize(, .Columns.Count - 1).SpecialCells(xlCellTypeVisible)
    • Schöne Arbeit! Ich wusste nicht, über AutoFilter. Das ist ziemlich cool.
    InformationsquelleAutor Dmitry Pavliv
  2. 2

    Ist es einfach genug, mit einem makro. Angenommen, Sie kopieren, wird das erste Blatt auf das zweite Blatt, und dass Ihre obigen Beispiel ist in den Spalten A und B, können Sie das folgende tun:

    Public Sub ConditionalCopy()

    Dim copyRng As Range
    Set copyRng = Worksheets(1).Range("B2:B7")

    Dim pasteRng As Range
    Set pasteRng = Worksheets(2).Range("A2")

    Dim i As Long
    i = 0

    For Each cell in copyRng.Cells
       If cell.Offset(0, -1).Value2 = "yes" Then
          pasteRng.Offset(i,0).Value2 = cell.Value2
          i = i + 1
       End If
    Next cell
End Sub

    Tut es mit einer Formel stellt eine Herausforderung in Bezug auf die nicht verlassen werden alle leeren Zeilen auf das zweite Blatt. Es wäre ziemlich trivial, nur die folgenden in das zweite Blatt:

    =If(A2 = "yes",b2,"")

    Und kopieren Sie es nach unten, aber du wirst am Ende mit leeren Zeilen, die Sie haben, zurück zu gehen und löschen sich selbst. Wenn Sie die Fähigkeit haben, um das makro zu verwenden, es ist einfach genug, dass ich diesen Weg gehen, anstatt zu sinken, zu viel Aufwand in die Entwicklung einer Formel. Je mehr ich darüber nachdenke, desto mehr fühle ich mich wie es zu sein hat, eine programmatische Lösung zur Vermeidung von doppelten Referenzen.

    InformationsquelleAutor tmoore82
  3. 2

    Wenn Sie mit separaten Zählern für die Quell-und Ziel-Reihen, und verwenden Sie Zellbezüge als vielmehr reicht die folgende routine sollte den trick tun

    Public Sub copyactivevalue()

Dim i As Integer
Dim j As Integer
Dim acts As Excel.Worksheet
Dim news As Excel.Worksheet

Set acts = Excel.Worksheets("sheet1")
Set news = Excel.Worksheets("sheet2")


With acts
    j = 2
    For i = 2 To 7
        If acts.Cells(i, 1).Value = "yes" Then
            news.Cells(j, 1) = acts.Cells(i, 2).Value
            j = j + 1
        End If

    Next
End With

Set acts = Nothing
Set news = Nothing
End Sub

    Hoffe, das hilft

    InformationsquelleAutor russjoliver
Schreibe einen Kommentar