Question

我正在尝试将源表中的行和列的子集自动复制到剪贴板中，以便在其他应用程序中使用。我正在表的标题上创建过滤器并正确过滤行，但不知道如何按我想要的顺序选择列的子集。源表是列A - L，我想在应用过滤器后按顺序将列C，I，H和F复制到剪贴板。下面包含一些代码（减去复制部分）。

Sub exportExample()
    Dim header As Range
    Dim srcCol As Range

    Set header = [A5:L5]

    header.AutoFilter
    header.AutoFilter 12, "Example", xlFilterValues

    'Copy out columns C, I, H and F of the resulting table in that order
End Sub

我可以弄清楚如何复制列，但无法弄清楚如何按照我想要的顺序获取它们。任何帮助是极大的赞赏！谢谢！

Answer 1

这是你在尝试什么？我已对代码进行了评论，以便您在理解代码时不会有任何问题。

<强> LOGIC ：

过滤数据
创建临时表
将过滤后的数据复制到临时表
删除不必要的列（A，B，D，E，G，J，K，L）
将相关列（C，F，H，I）重新排列为C，I，H和F
最后删除临时表（IMP：阅读代码末尾的注释）

代码（经过测试和测试）

Option Explicit

Sub Sample()
    Dim ws As Worksheet, wsTemp As Worksheet
    Dim rRange As Range, rngToCopy As Range
    Dim lRow As Long

    '~~> Change this to the relevant sheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        '~~> Get the Last Row
        lRow = .Range("L" & .Rows.Count).End(xlUp).Row

        '~~> Set your range for autofilter
        Set rRange = .Range("A5:L" & lRow)

        '~~> Remove any filters
        .AutoFilterMode = False

        '~~> Filter, copy visible rows to temp sheet
        With rRange
            .AutoFilter Field:=12, Criteria1:="Example"

            '~~> This is required to get the visible range
            ws.Rows("1:4").EntireRow.Hidden = True

            Set rngToCopy = .SpecialCells(xlCellTypeVisible).EntireRow

            Set wsTemp = Sheets.Add

            rngToCopy.Copy wsTemp.Range("A1")

            '~~> Unhide the rows
            ws.Rows("1:4").EntireRow.Hidden = False
        End With

        '~~> Remove any filters
        .AutoFilterMode = False
    End With

    '~~> Re arrange columns in Temp sheet so that we get C, I, H and F
    With wsTemp
        .Range("A:B,D:E,G:G,J:L").Delete Shift:=xlToLeft
        .Columns("D:D").Cut
        .Columns("B:B").Insert Shift:=xlToRight
        .Columns("D:D").Cut
        .Columns("C:C").Insert Shift:=xlToRight

        lRow = .Range("A" & .Rows.Count).End(xlUp).Row

        Set rngToCopy = .Range("A1:D" & lRow)

        Debug.Print rngToCopy.Address

        '~~> Copy the range to clipboard
        rngToCopy.Copy
    End With

    'NOTE
    '
    '~~> Once you have copied the range to clipboard, do the necessary
    '~~> actions and then delete the temp sheet. Do not delete the
    '~~> sheet before that. An alternative would be to use the APIs
    '~~> to place the range in the clipboard so you can safely delete
    '~~> the sheet before performing any actions. This will not clear
    '~~> clear the range if the sheet is immediately deleted.
    '
    '

    Application.DisplayAlerts = False
    wsTemp.Delete
    Application.DisplayAlerts = True
End Sub

<强> SCREENSHOT

Sheet1

enter image description here

带过滤数据的临时表

enter image description here

<强>后续

要删除边框，您可以将此代码添加到上面的代码

With rngToCopy
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
    .Borders(xlEdgeLeft).LineStyle = xlNone
    .Borders(xlEdgeTop).LineStyle = xlNone
    .Borders(xlEdgeBottom).LineStyle = xlNone
    .Borders(xlEdgeRight).LineStyle = xlNone
    .Borders(xlInsideVertical).LineStyle = xlNone
    .Borders(xlInsideHorizontal).LineStyle = xlNone
end with

将上述代码放在第Debug.Print rngToCopy.Address行

Answer 2

您必须单独复制列，因为引用范围的对象需要单元格有序。

这样的事情应该有效：

activeworkbook.Sheets(1).Columns("C:C").copy activeworkbook.Sheets(2).Columns("A:A")
activeworkbook.Sheets(1).Columns("I:I").copy activeworkbook.Sheets(2).Columns("B:B")
activeworkbook.Sheets(1).Columns("H:H").copy activeworkbook.Sheets(2).Columns("C:C")
activeworkbook.Sheets(1).Columns("F:F").copy activeworkbook.Sheets(2).Columns("D:D")

然后你应该能够做到：

activeworkbook.Sheets(2).Columns("A:D").copy

将其送到剪贴板

VBA筛选表和结果列到剪贴板的复制子集

2 个答案: