Question

我对VBA很新，并且一直在使用宏录制器来创建宏。宏记录器只能带我到目前为止，我能够完成我需要做的2/3。

我尝试创建一个宏，我需要在三列中满足条件，复制符合条件的行，然后将其粘贴到工作簿上。标准是＆＃34; Open＆＃34; ＆＃34;临界＆＃34;和＆＃34;日期。＆＃34; 这是一个棘手的部分，日期需要大于特定日期，通过用户输入或引用第三个工作表中的单元格。有几千行，大约有19列，而我所尝试的所有代码都会导致崩溃。

获取前两个标准的代码示例：

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

一个---------------------------------------------- -------------------乙------------------------------ - - - - - - - - - - - - - - -C 打开------------------------------------------------- - - - 危急 - - - - - - - - - - - - - - - - - - - - - - ------- 1/25 ---打开------------------------------------ - - - - - - - - - -高 - - - - - - - - - - - - - - - ------------------------ 3/25 关闭 - - - - - - - - - - - - - - - - - - - - - - - - - - -危急 - - - - - - - - - - - - - - - - - - - - - - - ------ 3/24 打开 - - - - - - - - - - - - - - - - - - - - - - - - - - - -危急 - - - - - - - - - - - - - - - - - - - - - - --------- 1/25

任何帮助都会很棒！

Answer 1

如果你要写VBA，你将不得不最终停止依赖。选择。记录的代码是短期的，但通常是冗长而低效的。

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

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

完整档案位于链接

下方

Download File

Sheet1：它是您的行数据并单击功能按钮

Sheet2：它根据＆＃34; Open＆＃34;映射数据。＆安培; ＆＃34;临界＆＃34; ＆安培; ＆＃34;日期＆＃34; （＆＃34;日期＆＃34;根据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

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

2 个答案: