Excel VBA-Code zum Kopieren ausgebreiteten Daten und Einfügen in vertikaler Reihenfolge

Question

Wie Sie auf dem Screenshot sehen können (ich habe den Screenshot-Link unten zur Verfügung gestellt), habe ich ein Excel-Blatt mit vielen numerischen Daten. Ich habe bedingte Formatierung verwendet, um einige der Daten hervorzuheben. Mein Endziel ist es, diese hervorgehobenen Daten zu kopieren und in vertikaler Reihenfolge in ein neues Blatt einzufügen. Das Problem, dem ich gegenüberstehe, ist jedoch, dass diese Daten in vielen Zeilen und Spalten gestaffelt sind. So wird zum Beispiel eine markierte Daten in Zeile 120 Spalte BBQ. Ich möchte kopieren & einfügen alle diese ausgebreiteten hervorgehobenen Daten in einem neuen Blatt in vertikaler Reihenfolge. Ich kann einfach nicht herausfinden, was Code :(

Jede Art von Hilfe geschätzt wird zu geben. Danke!

Answer 1

die folgenden Versuchen. Änderungen an Blatt und Bereichsnamen nach Bedarf Es lädt die Daten in ein Array, testet, ob jeder Punkt kleiner oder gleich 50 ist (die Zeilen nach unten, dann über die Spalten ... aber Sie können die For Anweisungen ändern, wenn Sie möchten) und wenn ja, schreibt nach ein neues Blatt

Sub CopyConditionalData() 

Dim ws1 As Worksheet, ws2 As Worksheet 
Set ws1 = Worksheets("Sheet1") ' change as needed 
Set ws2 = Worksheets("Sheet2") ' change as needed 

Dim rRng As Range 
Set rRng = ws1.Range("A1:G100") 'change as needed 

Dim aRng As Variant 
aRng = rRng 

Dim lRows As Long, lCols As Long 
For lCols = 1 To rRng.Columns.Count 
    For lRows = LBound(aRng) To UBound(aRng) 
     If aRng(lRows, lCols) <= 50 Then 
      ws2.Range("A" & ws2.Rows.Count).End(xlUp).Offset(1) = aRng(lRows, lCols) 
     End If 
    Next 
Next 

End Sub 

Answer 2

Angenommen Sie 120 Zeilen und 100 Spalten Daten in Tabelle1 haben und die markierte Farbe ist gelb und die markierten Daten müssen Sheet2 kopiert werden, dann

Dim temp As Integer 
temp = 1 

For i = 1 To 120 
    For j = 1 To 100 
     Worksheets("Sheet1").Activate 
     If Cells(i, j).Interior.Color = RGB(255, 255, 0) Then 
      x = Cells(i, j).Value 
      Worksheets("Sheet2").Activate 
      Cells(temp, 1).Value = x 
      temp = temp + 1 
     End If 
    Next j 
Next i 

Answer 3

so .. nur die Werte unter 50 kopieren:]

set cell2 = Worksheets(2).Range("A1") 

For Each cell in Worksheets(1).UsedRange 
    If Not IsNumeric(cell.Value) And cell.Value <= 50 Then 
     cell2.Value2 = cell.Value2 
     Set cell2 = cell2.Offset(1) 
    End If 
Next 

Answer 4

Ich schlage vor, die Bedingte Formatierung zu entfernen, die Matrix (Zeilen und Spalten) beschriftend und dann unpivoting (zum Beispiel wie gezeigt here).

Anschließend die Zeilen nach relevanten Dekaden (10, 20, 30 usw. ... wie in D1) markieren und die erstellte Tabelle entsprechend anpassen.