子函数 VBA

Question

我有一个基于团队 A 的过滤器，看起来像这样

Sheets("Data").Range("A:X").copy  Destination:=Sheets("Team A").Range("A1")

Columns("R:R").Select
Selection.AutoFilter
ActiveSheet.Range("$R:$R48576").AutoFilter Field:=1, Criteria1:= _
"Team A"

我想按其他8个队过滤数据，然后分别粘贴到一个sheet中。

这是否可以使用带参数的子例程，而不是放置团队 A，我可以放置一个像 R 这样的变量名，它将遍历我可以引用的团队名称？

感谢帮助

Answer 1

是的，可以像你提到的那样创建一个子程序，我可能没有正确理解，但就像你的代码没有将正确的团队数据复制到工作表中一样，下面的例子反驳了这一点，但你总是可以把你的放回去.

Public Sub Sample()
Sample2 "Team A"
Sample2 "Team B"
Sample2 "Team C"
Sample2 "Team D"
Sample2 "Team E"
Sample2 "Team F"
Sample2 "Team G"
Sample2 "Team H"
End Sub

Private Sub Sample2(ByVal StrTeam As String)
Sheets("Data").Range("R:R").AutoFilter Field:=1, Criteria1:=StrTeam
Sheets("Data").Range("A:X").Copy Destination:=Sheets(StrTeam).Range("A1")
End Sub

Answer 2

与 Gary 类似的答案 - 这将执行除 'Data' 之外的所有 sheets，并且不需要单独的程序：

Sub Test()

    Dim wrkSht As Worksheet

    For Each wrkSht In ThisWorkbook.Worksheets
        If wrkSht.Name <> "Data" Then
            With ThisWorkbook.Worksheets("Data")
                .Columns("R:R").AutoFilter Field:=1, Criteria1:=wrkSht.Name
                .Range("A:X").Copy Destination:=wrkSht.Range("A1")
            End With
        End If
    Next wrkSht

End Sub

要排除 Data sheet 之外的内容，您可以使用：

Sub Test()

    Dim wrkSht As Worksheet

    For Each wrkSht In ThisWorkbook.Worksheets
        Select Case wrkSht.Name
            Case "Data", "SomeOtherSheet"
                'Do nothing.
            Case Else
                With ThisWorkbook.Worksheets("Data")
                    .Columns("R:R").AutoFilter Field:=1, Criteria1:=wrkSht.Name
                    .Range("A:X").Copy Destination:=wrkSht.Range("A1")
                End With
        End Select
    Next wrkSht

End Sub

Answer 3

试试这个

选项显式

Sub Test()
    Dim ws As Worksheet

    With ThisWorkbook.Worksheets("Data").Range("A:X")
        For Each ws In ThisWorkbook.Worksheets
            If InStr(ws.Name, "Team") > 0 Then
                .AutoFilter
                .Columns("R:R").AutoFilter Field:=18, Criteria1:=ws.Name
                If Application.WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then .SpecialCells(xlCellTypeVisible).Copy Destination:=ws.Range("A1")
                .AutoFilter
            End If
        Next ws
    End With
End Sub

子函数 VBA

Sub Function VBA

vba

loops

filter

functional-programming

subroutine