Question

我想首先告诉您，我花了至少2个小时在Stackoverflow和随机谷歌搜索结果上阅读不同的问题/答案。虽然很多问题/答案都涉及类似的问题，但我无法找到我的具体问题的答案。

每周，我都会根据特定条件手动将Excel工作表中的行复制到另一个Excel工作表中。在一列中，我感兴趣的细胞的价值是＆＃34;未完成＆＃34;在第二栏中，我正在寻找过去的截止日期，即过期的项目。如果满足两个条件，我将整行复制到另一个Excel文件中新创建的工作表中。

我了解VBA的基础知识，并考虑通过编写将各个行复制到另一个Excel文件和新工作表中的宏来简化生活。但是，我还没能写出相当复杂的宏:(

请你解释如何编写两个循环（某种类型），首先查看第一列（查找值不是X的单元格），然后在第二列中查找过去的日期，请帮助我然后复制这两个标准符合的行？甚至可以用VBA吗？我不是要求整个宏，因为我想弄清楚如何正确使用剩下的代码，但这些循环对于初学者来说非常复杂，我真的很感激这里的一些指导。

提前感谢您花时间阅读这段文字。

编辑：在检查excel-easy之后（感谢@ maxhob17）我设法取得了一些进展。请查看此代码，以便了解我的进度。此代码根据第一个标准（status = done）获取所有相关行，并将它们复制到同一Excel文件中的新工作表中。

Public Sub Copy_Relevant_Items()
Dim CurrentWorkbook As Workbook
Dim InputWS As Worksheet
Dim OutputWS As Worksheet

Set CurrentWorkbook = Workbooks(ActiveWorkbook.Name)
Set InputWS = CurrentWorkbook.Sheets("Overview")
Set OutputWS = CurrentWorkbook.Sheets("Relevant")

Dim criterion As String
criterion = "Done"
Dim cells As range, cell As range


'Find the last used row in a Column: column C in this example
With InputWS
  LastRow = .cells(.rows.Count, "C").End(xlUp).row
End With

Set cells = range("C2:C" & LastRow)

'Copy all the relevant rows into another sheet
For Each cell In cells
    If cell.Value <> criterion Then

        cell.EntireRow.Copy Destination:=OutputWS.range("A" & rows.Count).End(xlUp).Offset(1)

    End If
Next cell

End Sub

Answer 1

您可以使用AutoFilter()

假设您的数据库从A列到D列，而日期在D列，那么您可以编码

Option Explicit

Public Sub Copy_Relevant_Items()
    Dim InputWS As Worksheet, OutputWS As Worksheet
    Dim criterion As String

    Set InputWS = ActiveWorkbook.Sheets("Overview")
    Set OutputWS = ActiveWorkbook.Sheets("Relevant")
    criterion = "Done"

    With InputWS
        With .Range("A1:D" & .cells(.Rows.Count, 1).End(xlUp).Row) '<--| reference its columns A to C from row 1 down to column A last not empty row. Change A and D to your actual data limit columns index
            MsgBox .Address
            .AutoFilter Field:=3, Criteria1:="<>" & criterion '<--| filter column C cells with content different from 'Criterion'. change "3" to your actual relative position of "status" column inside your database
            .AutoFilter Field:=4, Criteria1:="<" & CLng(Date)   '<--| filter column D cells with content less than current date. change "4" to your actual relative position of "date" column inside your database
            If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Copy Destination:=OutputWS.Range("A" & Rows.Count).End(xlUp).Offset(1) '<--| if any cell filtered other than headers then copy them to 'OutputWS'
        End With
    End With
End Sub

根据条件

1 个答案: