Question

我正在尝试创建一个宏：

通过表格
查看该表的B列中的值是否具有特定值
如果有，则将该行复制到其他工作表中的范围

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

我对vba不熟悉并且真的不知道从哪里开始，任何帮助都非常感激。

Answer 1

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

Sheets("Sheet1").Range("A1:D17").AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Sheets("Sheet1").Range("G1:G2"), CopyToRange:=Range("A1:D1") _
    , Unique:=False

Answer 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

Answer 3

试试这样：

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

Answer 4

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

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

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

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

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

如果你必须把它作为一个宏，你可以使用VLOOKUP作为一个应用程序功能 - 一个性能低下的快速解决方案 - 或者你必须自己制作一个simillar函数。

如果必须是后者，则需要有关性能问题的详细说明。

您可以将任何范围复制到数组，遍历此数组并检查您的值，然后将此值复制到任何其他范围。这就是我将如何解决这个问题作为一个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中，或者知道如何返回像对象一样的范围 - 也许我也可以，但今天不能;）

如果表中的值满足条件，则Vba宏从表复制行

4 个答案: