将可见细胞转移至最后一列

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循环迭代它。

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