4

我正在尝试制作一个宏：

  1. 穿过一张桌子
  2. 查看该表 B 列中的值是否具有特定值
  3. 如果有，将该行复制到另一个工作表中的范围

结果类似于过滤表，但我想避免隐藏任何行

我对vba有点陌生，真的不知道从哪里开始，非常感谢任何帮助。

4

4 回答 4

6

这正是您使用高级过滤器所做的事情。如果是一次性的，你甚至不需要宏，它在数据菜单中可用。

Sheets("Sheet1").Range("A1:D17").AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Sheets("Sheet1").Range("G1:G2"), CopyToRange:=Range("A1:D1") _
    , Unique:=False
于 2012-08-29T19:44:11.877 回答
2

试试这样：

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
于 2012-08-29T12:00:23.410 回答
2

选择是缓慢且不必要的。下面的代码会快得多：

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
于 2012-08-29T19:18:12.060 回答
0

您正在描述一个问题，我将尝试使用 VLOOKUP 函数而不是使用 VBA 来解决该问题。

您应该始终首先考虑非 vba 解决方案。

以下是 VLOOKUP（或德语中的 SVERWEIS，据我所知）的一些应用示例：

http://www.youtube.com/watch?v=RCLUM0UMLXo

http://office.microsoft.com/en-us/excel-help/vlookup-HP005209335.aspx

如果您必须将其作为宏，您可以将 VLOOKUP 用作应用程序功能 - 一种性能较慢的快速解决方案 - 或者您必须自己制作一个类似的功能。

如果必须是后者，则需要有关性能问题的规范的更多详细信息。

您可以将任何范围复制到数组中，循环遍历该数组并检查您的值，然后将该值复制到任何其他范围。这就是我将其作为 vba 函数解决的方法。

这看起来像这样：

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

您可以像这样在工作表中使用它 =FILTER(Tabelle1!A:C;2) 或使用 =INDEX(FILTER(Tabelle1!A:C;2);3) 来指定结果行。我相信有人可以扩展它以将索引功能包含到 FILTER 中，或者知道如何返回一个类似对象的范围——也许我也可以，但今天不行；）

于 2012-08-29T12:07:13.140 回答