VBA筛选器表和结果列的子集复制到剪贴板 [英] VBA Filter Table and Copy Subset of Resulting Columns to Clipboard

问题描述

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

I am trying to automatically copy a subset of rows and columns from a source table into the clipboard for use in other applications. I am creating the filter on the header of the table and filtering the rows correctly but do not know how to then select the subset of columns in the order I want. The source table is Columns A - L and I want to copy out Columns C, I, H and F in that order to the clipboard after applying the filter. Some code (minus the copy part) is included below.

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

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

I can figure out how to copy the columns but can't figure out how to get them in the order I want. Any help is greatly appreciated! Thanks!

推荐答案

这是您要尝试的吗？我对代码进行了注释，以便您理解它时不会遇到任何问题。

Is this what you are trying? I have commented the code so that you shouldn't have any problem understanding it.

LOGIC ：

1. 过滤数据


2. 创建临时表


3. 将过滤后的数据复制到临时表
   
4. 删除不必要的列（A，B，D，E，G，J，K，L）


5. 重新排列相关列（C，F，H， I）TO C，I，H和F


6. 最后删除临时表（IMP：阅读代码末尾的注释）

1. Filter the data
2. Create a Temp Sheet
3. Copy filtered data to temp sheet
4. Delete unnecessary columns (A,B,D,E,G,J,K,L)
5. Rearrange relevant columns (C,F,H,I) TO C,I,H and F
6. Delete Temp Sheet in the end (IMP: Read notes at the end of the code)

代码（经过测试的）

CODE (Tried And Tested)

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

屏幕截图

Sheet1在代码已运行

Sheet1 before the code is run

带有过滤数据的临时表

关注

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

To remove borders you can add this code to the above code

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

这篇关于VBA筛选器表和结果列的子集复制到剪贴板的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！