问子函数VBA
EN

Stack Overflow用户

提问于 2016-06-08 02:22:04

回答 3查看 126关注 0票数 1

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

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

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

我想过滤其他8个团队的数据，并将数据粘贴到每个工作表中。

这是否有可能使用带有参数的子例程，所以我可以不把团队A放在一个变量名上，比如R，它会循环遍历我可以引用的团队名称吗？

谢谢你的帮助

vba

loops

filter

functional-programming

subroutine

回答 3

Stack Overflow用户

回答已采纳

发布于 2016-06-08 03:01:02

与Gary的答案类似--这将处理除“数据”之外的所有工作表，并且不需要单独的过程：

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工作表更多的数据，可以使用：

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

票数 1

Stack Overflow用户

发布于 2016-06-08 02:56:04

是的，可以像您提到的那样创建一个子例程，我可能还没有正确理解，但是就像您的代码没有将正确的团队数据复制到工作表一样，下面的示例会说明这一点，但是您可以始终将您的代码放回原处。

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

票数 1

Stack Overflow用户

发布于 2016-06-08 03:31:26

尝尝这个

选项显式

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