復制，粘貼基於多個條件的選擇到VBA中的另一個工作表

Question

我是VBA的新手，一直在使用宏記錄器來創建宏。 宏記錄器只能帶我走這么遠，我能夠完成我需要完成的任務的2/3。

我正在嘗試創建一個宏，在該宏中我需要在三列中滿足條件，復制符合條件的行，然后將其粘貼到工作簿上。 條件是“打開”，“嚴重”和“日期”。 這是棘手的部分，通過用戶輸入或引用第三個工作表中的單元格，日期需要大於特定日期。 有幾千行，大約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

一種 - - - - - - - - - - - - - - - - - - - - - - - - - ---------------- B --------------------------------- -------------------------- C打開---------------------- - - - - - - - - - - - - - - - - -危急 - - - - - - - - ---------------------------------- 1/25 ---打開--------- - - - - - - - - - - - - - - - - - - - - - - - 高 - - -------------------------------------------------- -3/25關閉------------------------------------------------ - - - -危急 - - - - - - - - - - - - - - - - - - - - - ---------- 3/24打開------------------------------------ - - - - - - - - - 危急 - - - - - - - - - - - - - - - - ---------------------- 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

您可能需要研究錯誤控制並在上面添加一些內容。

推薦閱讀： 如何避免在Excel VBA中使用Select 。

Answer 2

我是這樣設計的。 試試吧。

完整文件位於鏈接下方

下載文件

Sheet1：這是您的行數據，然后單擊功能按鈕

Sheet2：根據“打開”，“關鍵”和“日期”映射數據（根據Sheet3輸入的“日期”）

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