Excel VBA - 自动筛选（2 列 / 2 个条件）复制与条件不匹配的行答案

【问题标题】：Excel VBA - Autofilter (2 columns / 2 criteria) copies rows that don't match with the criteriaExcel VBA - 自动筛选（2 列 / 2 个条件）复制与条件不匹配的行
【发布时间】：2016-08-10 19:36:00
【问题描述】：

当我使用以下 VBA 代码时：

With Range("A6:T" & lngLastRow)
    .AutoFilter
    .AutoFilter Field:=6, Criteria1:="Alexandra"
    .AutoFilter Field:=19, Criteria1:="-14"
    .Copy AlexSheet.Range("A3")
    .AutoFilter
End With

它会复制自动筛选字段 6 中名称为“Alexandra”的行，但也会复制自动筛选字段 19（不是 -14）中具有不同名称和不同值的 1 或 2 行

我不知道是什么导致 Excel/VBA 复制我从未请求过的行。

我希望有人可以帮助我。

完整代码：

Sub DeleteFilterAndCopy()

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Sheets("Alex").Range("A3:T1000").clearcontents
Sheets("Anett Edith").Range("A3:T1000").clearcontents
Sheets("Angela").Range("A3:T1000").clearcontents
Sheets("Dirk").Range("A3:T1000").clearcontents
Sheets("Daniel").Range("A3:T1000").clearcontents
Sheets("Klaus").Range("A3:T1000").clearcontents
Sheets("Konrad").Range("A3:T1000").clearcontents
Sheets("Marion").Range("A3:T1000").clearcontents
Sheets("MartinX").Range("A3:T1000").clearcontents
Sheets("Michael").Range("A3:T1000").clearcontents
Sheets("Mirko").Range("A3:T1000").clearcontents
Sheets("Nils").Range("A3:T1000").clearcontents
Sheets("Ulrike").Range("A3:T1000").clearcontents

Dim lngLastRow As Long
Dim AlexSheet As Worksheet, AnettEdithSheet As Worksheet, AngelaShett As Worksheet, DanielSheet As Worksheet
Dim DirkSheet As Worksheet, KlausSheet As Worksheet, Konradsheet As Worksheet
Dim MarionSheet As Worksheet, MartinSheet As Worksheet, MichaelSheet As Worksheet, MirkoSheet As Worksheet
Dim NilsSheet As Worksheet, Ulrikesheet As Worksheet

Set AlexSheet = Sheets("Alex")
Set AnettEdithSheet = Sheets("Anett Edith")
Set AngelaSheet = Sheets("Angela")
Set DanielSheet = Sheets("Daniel")
Set DirkSheet = Sheets("Dirk")
Set KlausSheet = Sheets("Klaus")
Set Konradsheet = Sheets("Konrad")
Set MarionSheet = Sheets("Marion")
Set MartinSheet = Sheets("MartinX")
Set MichaelSheet = Sheets("Michael")
Set MirkoSheet = Sheets("Mirko")
Set NilsSheet = Sheets("Nils")
Set Ulrikesheet = Sheets("Ulrike")

lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row

With Range("A6:T" & lngLastRow)
    .AutoFilter
    .AutoFilter Field:=6, Criteria1:="Alexandra"
    .AutoFilter Field:=19, Criteria1:="-14"
    .Copy AlexSheet.Range("A3")
    .AutoFilter Field:=6, Criteria1:="Anett / Edith"
    .Copy AnettEdithSheet.Range("A3")
    .AutoFilter Field:=6, Criteria1:="Angela"
    .Copy AngelaSheet.Range("A3")
    .AutoFilter Field:=6, Criteria1:="Daniel"
    .Copy DanielSheet.Range("A3")
    .AutoFilter Field:=6, Criteria1:="Dirk"
    .Copy DirkSheet.Range("A3")
    .AutoFilter Field:=6, Criteria1:="Klaus"
    .Copy KlausSheet.Range("A3")
    .AutoFilter Field:=6, Criteria1:="Konrad"
    .Copy Konradsheet.Range("A3")
    .AutoFilter Field:=6, Criteria1:="Marion"
    .Copy MarionSheet.Range("A3")
    .AutoFilter Field:=6, Criteria1:="Martin"
    .Copy MartinSheet.Range("A3")
    .AutoFilter Field:=6, Criteria1:="Michael"
    .Copy MichaelSheet.Range("A3")
    .AutoFilter Field:=6, Criteria1:="Mirko"
    .Copy MirkoSheet.Range("A3")
    .AutoFilter Field:=6, Criteria1:="Nils"
    .Copy NilsSheet.Range("A3")
    .AutoFilter Field:=6, Criteria1:="Ulrike"
    .Copy Ulrikesheet.Range("A3")
    .AutoFilter
End With

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

End Sub

数据截图：

获取过滤器并从中复制的数据（橙色列 = 自动过滤器字段）：

问题在于，宏不仅复制包含 Planner Alexandra 和值 -14 的行，它还复制两个单元格中具有不同值的 1-2 行。

问候

【问题讨论】：

我想知道您是否在单元格 A1 到 A5 中赋值？这可能会混淆自动过滤
你是对的......这就是原因。请发一个帖子，以便我标记您的答案
感谢指正。

标签： vba excel

【解决方案1】：

试试这个

With Range("A6:T" & lngLastRow)
    .AutoFilter Field:=6, Criteria1:="Alexandra"
    .AutoFilter Field:=19, Criteria1:="-14"
    .SpecialCells(xlCellTypeVisible).Copy AlexSheet.Range("A3")
End With

【讨论】：

【解决方案2】：

     It's ? like how are you coping autofiltered data..
     Copy only special rows

     Range("A1").Select''Destination where want to paste
     'Use below code to paste
     Selection.PasteSpecial Paste:=xlPasteValue

【讨论】：

select 不起作用，因为该功能更长，并且对 15 人和 15 张纸做同样的事情
发布你现有的功能..这将帮助我理解那是什么

【解决方案3】：

'For each new FilterCombinations criteria call this sub or modify according to your need
Sub Macro()
Range("A1").Select ''Assuming that 1st row is for header
ActiveCell.Offset(1, 0).Select

Dim intSpRowCount As Integer
intSpRowCount = Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Rows.count

If Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Rows.count > 1 Then
'copy only visible range
Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(intSpRowCount - 1, Int(ActiveSheet.UsedRange.Rows.count) - 1)).Select
Selection.Copy

Sheets("Sheet3").Select
Range("A6").Select
ActiveSheet.Paste
End If
End Sub

【讨论】：