将基于多个条件的选择复制、粘贴到 VBA 中的另一个工作表

Question

我是 VBA 的新手，一直在使用宏记录器创建宏。宏记录器只能带我到此为止，我只能完成我需要完成的 2/3。

我正在尝试创建一个宏，其中我需要在三列中满足条件，复制满足条件的行，并将其粘贴到工作簿中。条件是 "Open" "Critical" 和 "Date." 这是棘手的部分，日期要么需要大于特定日期，要么通过用户输入，要么通过引用第三个工作表中的单元格。有几千行，大约 19 列，我尝试的所有代码都导致崩溃 excel。

获取前两个条件的代码示例：

Sheets("Sheet1").Select
    ActiveSheet.ListObjects("Table_owssvr").Range.AutoFilter Field:=12, _
    Criteria1:="Open"
ActiveSheet.ListObjects("Table_owssvr").Range.AutoFilter Field:=16, _
    Criteria1:="Critical"
Range("Table_owssvr").Select
Range("Q83").Activate
Selection.Copy
Sheets("Sheet2").Select Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste

A---------------------------------------- ----------------------B---------------------------- - - - - - - - - - - - - - - - -C 打开 - - - - - - - - - - - - - - - - - - - - - - - - - ------Critical--------------------------------------------------1/25---Open-------------------------------------------------------High------------------------------------------------------3/25 Closed----------------------------------------------------Critical----------------------------------------------------3/24 Open------------------------------------------------------Critical-----------------------------------------------------1/25

任何帮助都会很棒！

Answer 1

如果您要编写 VBA，您最终将不得不停止依赖 .Select。录制的代码短期内很好，但通常冗长且效率低下。

Option Explicit

Sub wqewqwew()
    Dim col1 As Long, col2 As Long, col3 As Long, dt As Date
    Dim ws2 As Worksheet

    Set ws2 = Worksheets("sheet2")

    With Worksheets("sheet1").ListObjects("Table_owssvr")
        With .HeaderRowRange
            col1 = Application.Match("open", .Cells, 0)
            col2 = Application.Match("critical", .Cells, 0)
            col3 = Application.Match("date", .Cells, 0)
            dt = CDate(Application.InputBox(prompt:="greater then when?", Title:="pick date", Default:=Date))
        End With
        With .Range
            .AutoFilter
            .AutoFilter field:=col1, Criteria1:="open"
            .AutoFilter field:=col2, Criteria1:="critical"
            .AutoFilter field:=col3, Criteria1:=">" & dt
        End With
        With .DataBodyRange
            If CBool(Application.Subtotal(103, .Cells)) Then
                .Copy Destination:=ws2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            End If
        End With
        With .Range
            'turn off filters
            .AutoFilter
        End With
    End With
End Sub

您可能想要研究错误控制并在上面添加一些内容。

推荐阅读：How to avoid using Select in Excel VBA.

Answer 2

我是这样设计的。试试吧。

完整文件在link

下方

Download File

Sheet1 : 这是您的行数据并单击功能按钮

Sheet2 : 是根据 "Open" & "Critical" & "Date" 映射数据 (根据Sheet3输入的"Date")

Sheet3 : 输入你想要的日期

完整代码如下

Option Explicit

Private Sub Click_Click()

    Dim i As Integer

    For i = 2 To Worksheets("Sheet1").Range("A65536").End(xlUp).Row

        If Worksheets("Sheet1").Range("A" & i) = "Open" And _
            Worksheets("Sheet1").Range("B" & i) = "Critical" And _
            Worksheets("Sheet1").Range("C" & i) > Worksheets("Sheet3").Range("A2") Then

            Worksheets("Sheet1").Rows(i).Copy Worksheets("Sheet2").Range("A" & Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row + 1)

        End If
    Next

End Sub

将基于多个条件的选择复制、粘贴到 VBA 中的另一个工作表

copy, paste selection based on multiple criteria to another worksheet in VBA

excel

vba

copy

paste