2017-04-19 2 views
1

Dies ist ein bis zu meiner vorherigen Frage folgen, die hereWie man identifizierte Werte in ein neues Blatt exportiert?

Nur für eine kurze Zusammenfassung gefunden werden kann, habe ich diese Tabelle:

ID Age Grade 
1 14 90 
2 15 78 
3 14 90 
4 16 86 
5 16 86 
6 15 89 
7 14 88 

Tabelle Meiner gewünschte Ausgabe in einem neuen Blatt ist:

ID Age Grade 
1 14 90 
3 14 90 
4 16 86 
5 16 86 

ich ging durch und nahm die Zeilen aus, die sich wiederholende Werte in Spalte B haben uND Spalte C t mit Sein:

Jetzt muss ich nur herausfinden, wie diese Zeilen in ein neues Blatt zu exportieren, und ich habe keine Ahnung, wo ich anfangen soll.

Antwort

2

Code aktualisiert zu zeigen, wie die gefundenen Zeilen in ein neues Blatt zu exportieren:

Sub Export() 

Dim lastRowcheck As Long, n1 As Long 
Dim rCopy As Range 

With Worksheets("Sheet1") 
    lastRowcheck = Application.Max(.Range("B" & .Rows.Count).End(xlUp).Row, _ 
            .Range("C" & .Rows.Count).End(xlUp).Row) 

    For n1 = lastRowcheck To 1 Step -1 
     If Application.CountIfs(.Columns("B"), .Cells(n1, "B").Value2, .Columns("C"), .Cells(n1, "C").Value2) > 1 Then 
      Debug.Print .Cells(n1, "A") & ":" & .Cells(n1, "B") & ":" & .Cells(n1, "C") 
      '''export to new sheet 
      If rCopy Is Nothing Then Set rCopy = .Rows(n1) Else Set rCopy = Union(rCopy, .Rows(n1)) 
     End If 
    Next n1 
End With 


With Sheets("Sheet2")       'For using a sheet that already exists 
'With Sheets.Add(After:=Sheets(Sheets.Count)) 'For creating a brand new sheet to use 
    If Not rCopy Is Nothing Then rCopy.EntireRow.Copy _ 
     Destination:=.Cells(.Rows.Count, "A").End(xlUp).Offset(1) 
End With 

End Sub 
+0

das ist genial! genau das was ich gesucht habe. Gibt es einen Grund, warum die Spaltenüberschriften nicht auf das neue Blatt gelangten? – Abtra16

+1

Die Spaltenüberschriften wurden nicht als Teil von 'rCopy' identifiziert. Sie müssten eine Zeile vor die Schleife setzen und die Kopfzeile zu "rCopy" hinzufügen. – tigeravatar

+0

großartig! Ich habs! Vielen Dank!! – Abtra16

1

Warum Sie Schleife verwenden in absteigender Reihenfolge

For n1 = lastRowcheck To 1 Step -1 

For n1 = 1 To lastRowcheck 

während Sie es verwenden können, wenn Sie brauchen Ergebnis in der gleichen Reihenfolge wie pro Daten.

Sub Export() 
Dim lastRowcheck As Long, n1 As Long, i As Long 
Dim ws As Worksheet 
Set ws = Sheets("NewSheet") 'sheet name to export data 
i = 2 'add data from row 2 in new sheet 
With Worksheets("Sheet1") 
lastRowcheck = Application.Max(.Range("B" & .Rows.Count).End(xlUp).Row, _ 
           .Range("C" & .Rows.Count).End(xlUp).Row) 
For n1 = 1 To lastRowcheck 
    If Application.CountIfs(.Columns("B"), .Cells(n1, "B").Value2, .Columns("C"), .Cells(n1, "C").Value2) > 1 Then 
     Debug.Print .Cells(n1, "A") & ":" & .Cells(n1, "B") & ":" & .Cells(n1, "C") 
     '''export to new sheet 
     ws.Cells(i, "A") = .Cells(n1, "A") 
     ws.Cells(i, "B") = .Cells(n1, "B") 
     ws.Cells(i, "C") = .Cells(n1, "C") 
     i = i + 1 
    End If 
Next n1 
End With 

End Sub

Verwandte Themen