Question

此代码大部分可用，但它会复制数据集中的所有数据，而不仅仅是已过滤的数据。当我单步执行过滤器时，过滤器正常工作，但它会复制所有内容。我做错了什么？

Sub Auto_Filter()

Dim RNG As Range
Dim Open_Jobs_Report As Worksheet
Set Open_Jobs_Report = ThisWorkbook.Sheets("Open Jobs Report")
Dim Calculations As Worksheet
Set Calculations = ThisWorkbook.Sheets("Calculations")
Dim PersonResponsible As Range
Dim Violations As Range
Dim CLM1 As Long
Dim CLM2 As Long


    With Sheets("Open Jobs Report")
        Set RNG = .Range("A1", .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row, .Cells(1, .Columns.Count).End(xlToLeft).Column))
        RNG.AutoFilter Field:=19, Criteria1:="<>"

        CLM1 = .Range("1:1").Find(What:="Person Responsible").Column
        Set PersonResponsible = .Range(.Cells(1, CLM1), .Cells(1, CLM1).End(xlDown))
        CLM2 = .Range("1:1").Find(What:="Violations").Column
        Set Violations = .Range(.Cells(1, CLM2), .Cells(1, CLM2).End(xlDown))

    End With


    Calculations.Range("A:A").Value = PersonResponsible.Value
    Calculations.Range("B:B").Value = Violations.Value




    With Sheets("Open Jobs Report")

    ActiveSheet.ListObjects(1).AutoFilter.ShowAllData '<= Fix this

    End With

End Sub

Answer 1

这样的东西可以工作，用你需要复制数据的任何其他范围替换范围。

dim r As Range 
dim x(1 to 100,1 to 1) 
i = 1 
   For Each r In PersonResponsible.SpecialCells(xlCellTypeVisible)
        x(i,1) = r :i = i + 1 
   Next
   Calculations.Range("A1").resize(i-1).value = x

编辑：也许是这样的，

PersonResponsible.SpecialCells(xlCellTypeVisible).Copy _
        Destination:=Calculations.Range("A1")

Answer 2

使用Advanced Filter之类的内容：

Dim rCriteria as Range
Set rCriteria = [Headears of columns you want]

RNG.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= rCriteria, _  
                        CopyToRange:=[where you want], Unique:=True

用于仅复制过滤数据的代码

2 个答案: