Question

我是VBA的新手，经过多次搜索后，我无法正常使用该代码。我试图过滤/选择列B中值为313且列C中值为1或2的任何内容，然后使用同一工作表底部所有列（A-N）中的数据复制所有相关行。工作表没有设定的行数，313并不总是在同一组单元格中。我尝试了以下但是代码似乎是粘贴在＆＃39; A2＆＃39;而不是底部的选择。任何帮助将不胜感激。

Sub CopyPartOfFilteredRange()
Dim ws1 As Worksheet
Dim filterRange As range
Dim copyRange As range
Dim lastRow As Long

Set ws1 = ThisWorkbook.Sheets("Sheet 1")

ws1.AutoFilterMode = False

lastRow = ws1.range("A" & ws1.Rows.Count).End(xlUp).Row

Set filterRange = ws1.range("A1:N" & lastRow)


Set copyRange = ws1.range("A2:N" & lastRow)

 filterRange.AutoFilter Field:=2, Criteria1:="313"
filterRange.AutoFilter Field:=3, Criteria1:="=1", _
    Operator:=xlAnd, Criteria2:="=2"


lastRow = ws1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
  ws1.Cells(lastRow, 1).Select
ws1.Paste


 ws1.AutoFilterMode = False
End Sub

Answer 1

我相信，因为您正在重新定义过滤器之后的最后一行，所以使用xlUp将错过最后一行，因为它可能隐藏在过滤器中。我建议使用

lastRow = lastRow + 1

因为你已经定义了范围的最后一行，你只想在那之下经过一行。

顺便说一句，你的第二个过滤器将不会过滤，因为没有单元格将等于1且等于2.不确定你想要什么。无论如何，就像我在评论中说的那样，我不相信你在复制任何东西，所以你需要

filterRange.Copy

过滤后的

。我不确定我会建议像这样复制和粘贴，但我会尝试修改你的代码而不是重写它。

另外，我不相信

Set copyRange = ws1.range("A2:N" & lastRow)

是完全需要的，可以删除。

这就是我的全部内容

Sub CopyPartOfFilteredRange()
Dim ws1 As Worksheet
Dim filterRange As Range
Dim lastRow As Long
Set ws1 = Worksheets("Sheet1")
ws1.AutoFilterMode = False
lastRow = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row
Set filterRange = ws1.Range("A1:N" & lastRow)
filterRange.AutoFilter Field:=2, Criteria1:="313"
filterRange.Copy
lastRow = lastRow + 1
ws1.Cells(lastRow, 1).Select
ws1.Paste
ws1.AutoFilterMode = False
End Sub

Answer 2

你必须：

将xlAnd更改为xlOr
将lastRow增加1以引用要粘贴的单元格
使用SpecialCells(xlCellTypeVisible)选择已过滤的单元格（如果有的话）

试试他的

Option Explicit

Sub CopyPartOfFilteredRange()
    Dim lastRow As Long

    With ThisWorkbook.Sheets("Sheet 1")
        .AutoFilterMode = False

        lastRow = .Range("A" & .Rows.Count).End(xlUp).row
        With .Range("A1:N" & lastRow)
            .AutoFilter Field:=2, Criteria1:="313"
            .AutoFilter Field:=3, Criteria1:="1", Operator:=xlOr, Criteria2:="2"
            If Application.WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then 'count visible cells in column "A" other than the header
                .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy .Cells(lastRow + 1, 1)
            End If
        End With

         .AutoFilterMode = False
     End With
End Sub

过滤条件然后复制并粘贴到同一工作表的底部

2 个答案: