轉置可見單元格直到最後一列

Question

我有一個excel表單，基本上會有一個可變數字的列A到C，它被過濾爲基於for next循環的唯一值我已經實現了這一點，接下來我試圖複製從F列開始的可見範圍直到last column（因爲每次過濾器時都有可變列），並將它垂直轉置到新工作表中。我使用的方法是對每個可見行進行計數並複製直到結束。這是代碼。

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 

但有複製和轉置具有從F欄的值，直到最後一列的細胞？在上述例子中，從F108:H110選擇開始和只複製具有在它的值細胞的任何替代方式。

Answer 1

SpecialCells是Range的成員返回範圍Object。知道我們可以將它們連在一起.SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants)來縮小我們的範圍。這會給你一個不連續的範圍。您不能使用不連續的複製命令。如果將其分配給數組，則該數組只會部分填充。您必須用For Each循環迭代它。

 
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 

我只是遍歷所有的行檢查可見性。接下來只需將數據添加到數組中，並使用範圍調整大小來填充目標範圍。

 

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