Question

如果日期大于10/31/2013，我想获取所有行。

Private Sub CommandButton21_Click()

a = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To a

    If Worksheets("Sheet1").Cells(i, 7).Value > "10/31/2013" Then

        Worksheets("Sheet1").Rows(i).Copy
        Worksheets("Sheet2").Activate
        b = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
        Worksheets("Sheet2").Cells(b + 1, 1).Select
        ActiveSheet.Paste
        Worksheets("Sheet1").Activate

    End If

Next

Application.CutCopyMode = False
ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).Select

End Sub

如果我使用date = 10/31/2013，则我的代码有效。

我的日期列也有空值。

数据快照

Answer 1

日期是数字值。处理日期时，请使用#代替"。

应避免选择或激活范围，请注意Excel VBA Introduction Part 5 - Selecting Cells (Range, Cells, Activecell, End, Offset)。

Private Sub CommandButton21_Click()
    Application.ScreenUpdating = False
    Dim r As Long

    With ThisWorkbook.Worksheets("Sheet1")
        For r = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
            If .Cells(r, 7).Value > #10/31/2013# Then
                .Rows(r).Copy Destination:=Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1)
            End If
        Next
    End With

    Application.CutCopyMode = False

End Sub

Answer 2

您没有用一张纸适当地限制对象，这很可能是问题所在。我修改了您的代码以正确限定所有对象，这也将更快，因为它只会在循环外复制/粘贴一次。

例如，假设您有500行符合条件（Range > Date）。这意味着您将在循环中一遍又一遍地复制和粘贴500个行实例。以下方法仅具有一个复制/粘贴实例，并且与满足条件的行数无关。要复制的行越多，您将从该解决方案中受益越多。

另一种可能的解决方案是仅根据您的条件过滤并仅复制/粘贴可见单元格

已更新，可在评论中添加更多条件-经过测试，目前可以正常运行

Option Explicit

Private Sub CommandButton21_Click()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim i As Long, MyUnion As Range, LRow As Long

For i = 2 To ws.Range("A" & ws.Rows.Count).End(xlUp).Row
    If ws.Range("G" & i) > #10/31/2013# Or ws.Range("AA" & i) = "Investigate" Or ws.Range("AA" & i) = "Leave Open" Then
        If Not MyUnion Is Nothing Then
            Set MyUnion = Union(MyUnion, ws.Range("G" & i))
        Else
            Set MyUnion = ws.Range("G" & i)
        End If
    End If
Next i

If Not MyUnion Is Nothing Then
    With ThisWorkbook.Sheets("Sheet2")
        LRow = .Range("A" & .Rows.Count).End(xlUp).Offset(1).Row
        MyUnion.EntireRow.Copy .Range("A" & LRow)
    End With
End If

End Sub

之前和之后

Answer 3

您的>比较无法正常工作的原因是，您在比较中提供了一个字符串（用"包装）。如果要比较日期，请像下面这样提供用#包装的日期：

If CDate(Worksheets("Sheet1").Cells(i, 7).Value) > #10/31/2013# Then

请注意，我还确保使用CDate

将单元格中的值转换为Date数据类型。

一些其他评论，与您的问题没有直接关系

您在代码中使用了.select和.activate，但是直接与对象进行交互是一种更好的做法。例如，整个If块应该更像这样：

If CDate(Worksheets("Sheet1").Cells(i, 7).Value) > #10/31/2013# Then
    Worksheets("Sheet1").Rows(i).Copy
    b = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
    Worksheets("Sheet2").Cells(b + 1, 1).Paste
End If

拉条件列：日期大于2013年10月31日

3 个答案: