Вытянуть строки для условия: дата больше, чем 31.10.2013 - PullRequest
0 голосов
/ 19 ноября 2018

Я хочу получить все строки, если дата больше 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

Мой код работает, если я использую дату = 10/31/2013.

Мойстолбец даты также имеет нулевые значения.

Снимок данных
Here is the snapshot of data

Ответы [ 3 ]

0 голосов
/ 19 ноября 2018

Даты являются числовыми значениями.Используйте # вместо " при работе с датами.

Следует избегать выбора или активации диапазонов. Введение в Excel VBA, часть 5. Выбор ячеек (диапазон, ячейки, 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
0 голосов
/ 19 ноября 2018

Вы неправильно квалифицируете свои объекты с листом, который вполне может быть проблемой. Я адаптировал ваш код для правильной квалификации всех объектов, и это также будет намного быстрее, поскольку он будет копировать / вставлять вне цикла только один раз.

Например, скажем, у вас есть 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

До и после

enter image description here

enter image description here

0 голосов
/ 19 ноября 2018

Причина, по которой ваше > сравнение не работает так, как вы ожидаете, заключается в том, что вы указали строку (завернутую в ") в своем сравнении. Если вы хотите сравнить даты, укажите дату в #, например:

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

Обратите внимание, что я также обеспечил преобразование значения в вашей ячейке в тип данных Date с помощью CDate

Некоторые дополнительные комментарии, не относящиеся непосредственно к вашему вопросу:

Вы используете .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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...