Transponiere sichtbaren Zellen bis zur letzten Spalte

Question

Ich habe ein Excel-Blatt, das grundsätzlich eine variable Zahlen in Spalten A bis C hat, es wird gefiltert, um eindeutige Werte basierend auf for next Schleife Ich habe dies erreicht und als nächstes versuche ich kopiere den sichtbaren Bereich beginnend mit der Spalte F bis last column (da jedesmal wenn Filter variable Spalten sind) und transponiere ihn vertikal im neuen Blatt. Der Ansatz, den ich benutzt habe, zählt jede sichtbare Zeile und kopiert bis zum Ende. Hier ist der Code.

Set ws = ActiveSheet 
Set WS2 = ThisWorkbook.Sheets("3") 
L2 = ws.Cells(Rows.Count, 1).End(xlUp).Row 
For Each CELL In ws.Range("F2:F" & L2).SpecialCells(xlCellTypeVisible) 
    i = CELL.Row 
    L3 = ws.Cells(i, Columns.Count).End(xlToLeft).Column 
    ws.Range(Cells(i, 6), Cells(i, L3)).Copy 
    L4 = WS2.Cells(Rows.Count, 4).End(xlUp).Row 
    WS2.Cells(L4 + 1, 4).PasteSpecial Paste:=xlPasteAll, Transpose:=True 
Next CELL 

Aber gibt es eine andere Möglichkeit, Zellen zu kopieren und transponieren, die aus F108:H110 Werte aus Spalte F bis letzten Spalte? Im obigen Beispiel haben wählen Sie Start, und kopieren Sie nur Zellen, die Werte in ihm haben .

Answer 1

SpecialCells ist ein Mitglied von Range gibt einen Bereich Object zurück. Wissend, dass wir sie zusammenketten können .SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants), um unser Angebot einzuschränken. Dadurch erhalten Sie einen nicht kontinuierlichen Bereich. Sie können den Kopierbefehl nicht mit einem Non-Continuous-Befehl verwenden. Wenn Sie es einem Array zuweisen, wird das Array nur teilweise gefüllt. Sie müssen darüber mit einer For Each Schleife iterieren.

 
Sub SelectVisibleNonBlankCells() 
    Dim c As Range, r As Range 
    Dim L2 As Long 

    With ThisWorkbook.Sheets("3") 

     L2 = .Cells(Rows.Count, 1).End(xlUp).Row 
     Set r = .Range("F2:F" & L2).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants) 

    End With 

    For Each c In r 

    Next 

End Sub 

Ich würde nur über alle Zeilen iterieren, die auf Sichtbarkeit prüfen. Als Nächstes fügen Sie einfach die Daten zu einem Array hinzu und verwenden die Bereichsgröße, um den Zielbereich zu füllen.

 

Sub TransposeVisibleCells() 

    With ThisWorkbook.Sheets("3") 
     Dim ColumnCount As Integer, lastRow As Long, RowCount As Long, x As Long, y As Long 
     Dim arData 

     lastRow = .Cells(Rows.Count, 1).End(xlUp).Row 
     ColumnCount = .Cells(1, Columns.Count).End(xlToLeft).Column 

     ReDim arData(ColumnCount, RowCount) 
     For x = 2 To lastRow 

      If Not .Rows(x).Hidden Then 
       ReDim Preserve arData(ColumnCount, RowCount) 

       For y = 1 To ColumnCount 
        arData(y -1, RowCount) = .Cells(x, y).Value 
       Next 

       RowCount = RowCount + 1 
      End If 
     Next 

    End With 

    Worksheets("Transposed Data").Range("A1").Resize(ColumnCount, RowCount) = arData 
End Sub