如果表中的值满足条件，则 Vba 宏从表中复制行
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/12177125/
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 macro to copy row from table if value in table meets condition
提问by andrew b
i'm trying to make a macro which:
我正在尝试制作一个宏：
- goes through a table
- looks if value in column B of that table has a certain value
- if it has, copy that row to a range in an other worksheet
- 穿过一张桌子
- 查看该表 B 列中的值是否具有特定值
- 如果有，将该行复制到另一个工作表中的范围
The result is similar to filtering the table but I want to avoid hiding any rows
结果类似于过滤表，但我想避免隐藏任何行
I'm kinda new to vba and don't really know where to start with this, any help much appreciated.
我对 vba 有点陌生，真的不知道从哪里开始，非常感谢任何帮助。
回答by Patrick Honorez
That is exactly what you do with an advanced filter. If it's a one shot, you don't even need a macro, it is available in the Data menu.
这正是您使用高级过滤器所做的。如果它是一次性的，你甚至不需要宏，它在数据菜单中可用。
Sheets("Sheet1").Range("A1:D17").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Sheet1").Range("G1:G2"), CopyToRange:=Range("A1:D1") _
, Unique:=False
回答by The_Barman
Selects are slow and unnescsaary. The following code will be far faster:
选择缓慢且不必要。下面的代码会快得多：
Sub CopyRowsAcross()
Dim i As Integer
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Sheet2")
For i = 2 To ws1.Range("B65536").End(xlUp).Row
If ws1.Cells(i, 2) = "Your Critera" Then ws1.Rows(i).Copy ws2.Rows(ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row + 1)
Next i
End Sub
回答by Toni Kanoni
Try it like this:
像这样尝试：
Sub testIt()
Dim r As Long, endRow as Long, pasteRowIndex As Long
endRow = 10 ' of course it's best to retrieve the last used row number via a function
pasteRowIndex = 1
For r = 1 To endRow 'Loop through sheet1 and search for your criteria
If Cells(r, Columns("B").Column).Value = "YourCriteria" Then 'Found
'Copy the current row
Rows(r).Select
Selection.Copy
'Switch to the sheet where you want to paste it & paste
Sheets("Sheet2").Select
Rows(pasteRowIndex).Select
ActiveSheet.Paste
'Next time you find a match, it will be pasted in a new row
pasteRowIndex = pasteRowIndex + 1
'Switch back to your table & continue to search for your criteria
Sheets("Sheet1").Select
End If
Next r
End Sub
回答by Jook
you are describing a Problem, which I would try to solve with the VLOOKUP function rather than using VBA.
您正在描述一个问题，我会尝试使用 VLOOKUP 函数而不是使用 VBA 来解决该问题。
You should always consider a non-vba solution first.
您应该始终首先考虑非 vba 解决方案。
Here are some application examples of VLOOKUP (or SVERWEIS in German, as i know it):
以下是 VLOOKUP（或德语中的 SVERWEIS，据我所知）的一些应用示例：
http://www.youtube.com/watch?v=RCLUM0UMLXo
http://www.youtube.com/watch?v=RCLUM0UMLXo
http://office.microsoft.com/en-us/excel-help/vlookup-HP005209335.aspx
http://office.microsoft.com/en-us/excel-help/vlookup-HP005209335.aspx
If you have to make it as a macro, you could use VLOOKUP as an application function - a quick solution with slow performance - or you will have to make a simillar function yourself.
如果您必须将其制作为宏，则可以将 VLOOKUP 用作应用程序功能 - 一个性能缓慢的快速解决方案 - 或者您必须自己制作一个类似的功能。
If it has to be the latter, then there is need for more details on your specification, regarding performance questions.
如果必须是后者，则需要有关性能问题的规范的更多详细信息。
You could copy any range to an array, loop through this array and check for your value, then copy this value to any other range. This is how i would solve this as a vba-function.
您可以将任何范围复制到数组，循环遍历此数组并检查您的值，然后将此值复制到任何其他范围。这就是我将其作为 vba 函数解决的方法。
This would look something like that:
这看起来像这样：
Public Sub CopyFilter()
Dim wks As Worksheet
Dim avarTemp() As Variant
'go through each worksheet
For Each wks In ThisWorkbook.Worksheets
avarTemp = wks.UsedRange
For i = LBound(avarTemp, 1) To UBound(avarTemp, 1)
'check in the first column in each row
If avarTemp(i, LBound(avarTemp, 2)) = "XYZ" Then
'copy cell
targetWks.Cells(1, 1) = avarTemp(i, LBound(avarTemp, 2))
End If
Next i
Next wks
End Sub
Ok, now i have something nice which could come in handy for myself:
好的，现在我有一些不错的东西可以为自己派上用场：
Public Function FILTER(ByRef rng As Range, ByRef lngIndex As Long) As Variant
Dim avarTemp() As Variant
Dim avarResult() As Variant
Dim i As Long
avarTemp = rng
ReDim avarResult(0)
For i = LBound(avarTemp, 1) To UBound(avarTemp, 1)
If avarTemp(i, 1) = "active" Then
avarResult(UBound(avarResult)) = avarTemp(i, lngIndex)
'expand our result array
ReDim Preserve avarResult(UBound(avarResult) + 1)
End If
Next i
FILTER = avarResult
End Function
You can use it in your Worksheet like this =FILTER(Tabelle1!A:C;2) or with =INDEX(FILTER(Tabelle1!A:C;2);3) to specify the result row. I am sure someone could extend this to include the index functionality into FILTER or knows how to return a range like object - maybe I could too, but not today ;)
您可以像这样在工作表中使用它 =FILTER(Tabelle1!A:C;2) 或使用 =INDEX(FILTER(Tabelle1!A:C;2);3) 来指定结果行。我确信有人可以将其扩展为将索引功能包含到 FILTER 中，或者知道如何返回一个类似对象的范围——也许我也可以，但今天不行;)
