如果表中的值满足条件，VBAmacros将从表中复制行
我试图做一个macros：
- 经过一张桌子
- 看看该表的B列中的值是否具有一定的值
- 如果有，则将该行复制到另一个工作表中的范围
结果类似于筛选表，但我想避免隐藏任何行
我有点新vba，真的不知道从哪里开始，任何帮助非常感谢。
这正是你用高级filter所做的。 如果它是一次性的，你甚至不需要一个macros，它可以在数据菜单中find。
Sheets("Sheet1").Range("A1:D17").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Sheets("Sheet1").Range("G1:G2"), CopyToRange:=Range("A1:D1") _ , Unique:=False select是缓慢和unnescsaary。 下面的代码将会更快：
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
试试像这样：
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
你正在描述一个问题，我试图用VLOOKUP函数而不是使用VBA来解决这个问题。
您应该始终考虑首先使用非vba解决scheme。
下面是一些VLOOKUP的应用实例（或德国的SVERWEIS，据我所知）：
http://www.youtube.com/watch?v=RCLUM0UMLXo
http://office.microsoft.com/en-us/excel-help/vlookup-HP005209335.aspx
如果你必须把它作为一个macros，你可以使用VLOOKUP作为一个应用程序的function – 一个速度较慢的快速解决scheme – 或者你将不得不自己做一个simillarfunction。
如果必须是后者，那么就需要关于性能问题的更多细节。
您可以将任何范围复制到一个数组，循环这个数组并检查您的值，然后将此值复制到任何其他范围。 这是我将如何解决这个作为一个VBAfunction。
这看起来像这样：
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
好吧，现在我有一些很好的东西可以派上用场：
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
你可以在你的Worksheet中使用它，像这样= FILTER（Tabelle1！A：C; 2）或者用= INDEX（FILTER（Tabelle1！A：C; 2）; 3）指定结果行。 我相信有人可以扩展这个包括索引function到FILTER或知道如何返回一个范围类似的对象 – 也许我也可以，但不是今天;）