将可见单元格转置到最后一列

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 的成员，返回一个范围对象。知道我们可以将它们链接在一起.SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants) 以缩小我们的范围。这会给你一个不连续的范围。您不能将复制命令用于非连续。如果将其分配给数组，则该数组将仅被部分填充。您必须使用 For Each 循环对其进行迭代。

子 SelectVisibleNonBlankCells() 暗淡 c 作为范围，r 作为范围 将 L2 调暗 使用 ThisWorkbook.Sheets("3") L2 = .Cells(Rows.Count, 1).End(xlUp).Row 设置 r = .Range("F2:F" & L2).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants) 结束于 对于每个 c In r 下一个 结束子

我只会遍历所有行来检查可见性。接下来只需将数据添加到一个数组并使用范围调整大小来填充目标范围。

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