VBA 过滤表并将结果列的子集复制到剪贴板
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/12303770/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
VBA Filter Table and Copy Subset of Resulting Columns to Clipboard
提问by user1651899
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.
我正在尝试将源表中的行和列的子集自动复制到剪贴板以供其他应用程序使用。我正在表的标题上创建过滤器并正确过滤行，但不知道如何按照我想要的顺序选择列的子集。源表是列 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
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!
我可以弄清楚如何复制列，但无法弄清楚如何按照我想要的顺序获取它们。任何帮助是极大的赞赏！谢谢！
采纳答案by Siddharth Rout
Is this what you are trying? I have commented the code so that you shouldn't have any problem understanding it.
这是你正在尝试的吗？我已经对代码进行了注释，以便您理解它不会有任何问题。
LOGIC:
逻辑：
- Filter the data
- Create a Temp Sheet
- Copy filtered data to temp sheet
- Delete unnecessary columns (A,B,D,E,G,J,K,L)
- Rearrange relevant columns (C,F,H,I) TO C,I,H and F
- Delete Temp Sheet in the end (IMP: Read notes at the end of the code)
- 过滤数据
- 创建临时表
- 将过滤后的数据复制到临时表
- 删除不必要的列（A、B、D、E、G、J、K、L）
- 将相关列 (C,F,H,I) 重新排列为 C,I,H 和 F
- 最后删除Temp Sheet（IMP：阅读代码末尾的注释）
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
SCREENSHOT
截屏
Sheet1 before the code is run
代码运行前的 Sheet1
Temp sheet with filtered data
带有过滤数据的临时表
FOLLOWUP
跟进
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
Put the above code after the line Debug.Print rngToCopy.Address
把上面的代码放在一行之后 Debug.Print rngToCopy.Address
回答by SeanC
You will have to copy the columns out individually, as objects that refer to ranges require the cells to be in order.
您必须单独复制列，因为引用范围的对象要求单元格按顺序排列。
Something like this should work:
这样的事情应该工作：
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")
then you should be able to do:
那么你应该能够做到：
activeworkbook.Sheets(2).Columns("A:D").copy
to get it to the clipboard
把它放到剪贴板
