Question

我对VBA有点新意，所以希望能从你的专家那里得到一些帮助！我有以下要求：

我在Sheet2（范围）
我需要使用上述范围中的每个值过滤Sheet1中的数据，并将其保存在单独的工作表中。

那么，我该如何做呢？

Answer 1

看看这个（代码中有评论可以帮助你）：

Sub MKDev1()
Dim WsSrc As Worksheet, _
    WsFilt As Worksheet, _
    RgSrc As Range, _
    RgFilt As Range, _
    rCell As Range, _
    ColumnToFilter As Integer, _
    OutPutWs As Worksheet

'Define the name of your sheets
Set WsSrc = Sheets("Sheet1")
Set WsFilt = Sheets("Sheet2")
Set RgSrc = WsSrc.Range("A1:" & _
                ColLet(WsSrc.Columns(WsSrc.Columns.Count).End(xlToLeft).Column) & _
                WsSrc.Rows(WsSrc.Rows.Count).End(xlUp).Row)
'Change the column to the one in which you have the unique values
Set RgFilt = WsFilt.Range("A1:A" & Range("A" & WsFilt.Rows.Count).End(xlUp).Row)

'Set your column to filter (here "A"// 1st column)
ColumnToFilter = 1
If WsSrc.AutoFilterMode = False Then WsSrc.AutoFilterMode = True


For Each rCell In RgFilt
    Set OutPutWs = DeleteAndAddSheet(rCell.Value)
    RgSrc.AutoFilter Field:=ColumnToFilter, Criteria1:=rCell.Value

    '2 ways of copying
    'Less efficient (tested)
    RgSrc.AutoFilter.Range.Copy Destination:=OutPutWs.Range("A1")
    'More efficient (untested here)
    'OutPutWs.Range("A1").Value = RgSrc.AutoFilter.Range.Value

    'Get rid of previous filters
    RgSrc.AutoFilter.ShowAllData
Next rCell

ThisWorkbook.Save

Set WsSrc = Nothing
Set WsFilt = Nothing
Set RgSrc = Nothing
Set RgFilt = Nothing
Set OutPutWs = Nothing

End Sub

从索引获取列的字母引用的函数：

Public Function ColLet(x As Integer) As String
With ActiveSheet.Columns(x)
    ColLet = Left(.Address(False, False), InStr(.Address(False, False), ":") - 1)
End With
End Function

从名称中删除，创建和设置新工作表的功能：

Public Function DeleteAndAddSheet(ByVal SheetName As String) As Worksheet

For Each aShe In Sheets
    If aShe.Name <> SheetName Then
    Else
        Application.DisplayAlerts = False
        aShe.Delete
        Application.DisplayAlerts = True
        Exit For
    End If
Next aShe

Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = SheetName

Set DeleteAndAddSheet = ThisWorkbook.Worksheets(Worksheets.Count)

End Function

如何使用范围中的每个值来自动过滤另一个工作表中的数据？

1 个答案: