Question

我正在尝试编写一个vba脚本，它将过滤两列，A列和D列。最好，我想创建一个按钮，一旦我选择了过滤条件就会执行。以下输入数据样本。

 Sub Compiler()
  Dim i
  Dim LastRow As Integer

  LastRow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row

  Sheets("Sheet4").Range("A2:J6768").ClearContents

     For i = 2 To LastRow
          If Sheets("Sheet1").Cells(i, "A").Values = Sheets("Sheet3").Cells(3, "B").Values And Sheets("Sheet1").Cells(i, "D").Values = Sheets("Sheet3").Cells(3, "D").Values Then
             Sheets("Sheet1").Cells(i, "A" & "D").EntireRow.Copy Destination:=Sheets("Sheet4").Range("A" + Rows.Count).End(xlUp)
          End If
     Next i

End Sub

Sample Data to run vba script

Answer 1

我已将之前答案的更改包含在下面提供的完整代码块中。

Sub Compiler()
 Dim i
 Dim LastRow, Pasterow As Integer
 Dim sht As Worksheet

   Set sht = ThisWorkbook.Sheets("Sheet4")

   LastRow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row

  Sheets("Sheet4").Range("A2:J6768").ClearContents

    For i = 2 To LastRow
        If Sheets("Sheet1").Range("A" & i).Value = Sheets("Sheet3").Range("B3").Value And Sheets("Sheet1").Range("D" & i).Value = Sheets("Sheet3").Range("D3").Value Then
           Pasterow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row + 1
           Sheets("Sheet1").Rows(i).EntireRow.Copy Destination:=Sheets("Sheet4").Range("A" & Pasterow)
        End If
     Next i

 Sheets("sheet4").Rows(1).Delete

End Sub

Answer 2

Sheets("Sheet1").Cells(i, "A").Values
Sheets("Sheet3").Cells(3, "B").Values

等

您继续使用values。你的意思是value吗？

Answer 3

这回答了我提出的问题，我尝试使用Dan的答案，但没有达到目标。

Private Sub CommandButton1_Click()
FinalRow = Sheets("Sheet1").Cells(rows.Count, 1).End(xlUp).Row

Sheets("Sheet4").Range(Sheets("Sheet4").Cells(1, "A"), Sheets("Sheet4").Cells(FinalRow, "K")).ClearContents

If Sheets("Sheet4").Cells(1, "A").Value = "" Then
Sheets("Sheet1").Range("A1:K1").Copy
Sheets("Sheet4").Range(Sheets("Sheet4").Cells(1, "A"), Sheets("Sheet4").Cells(1, "K")).PasteSpecial (xlPasteValues)
End If

For x = 2 To FinalRow
    ThisValue = Sheets("Sheet1").Cells(x, "A").Value
    ThatValue = Sheets("Sheet1").Cells(x, "D").Value
    If ThisValue = Sheets("Sheet3").Cells(3, "B").Value And ThatValue = Sheets("Sheet3").Cells(3, "D").Value Then
    Sheets("Sheet1").Range(Sheets("Sheet1").Cells(x, 1), Sheets("Sheet1").Cells(x, 11)).Copy
    Sheets("Sheet4").Select
    NextRow = Sheets("Sheet4").Cells(rows.Count, 1).End(xlUp).Row + 1
    With Sheets("Sheet4").Range(Sheets("Sheet4").Cells(NextRow, 1), Sheets("Sheet4").Cells(NextRow, 11))
    .PasteSpecial (xlPasteFormats)
    .PasteSpecial (xlPasteValues)
    End With

    End If

    Next x

Worksheets("Sheet4").Cells.EntireColumn.AutoFit



End Sub

VBA动态过滤和复制粘贴到新工作表中

3 个答案: