Как мне исправить цикл Lmonth - PullRequest
0 голосов
/ 15 февраля 2019

У меня есть код Lmonth Loop, который ищет в списке дат, например, задания, которые были заказаны в январе (1), и копирует и вставляет их на новый лист.

Код работает нормально, но когда онзатем завершается, помечается @debug error 13 '

Если я отключаю строку, код не работает, но я не могу понять, что сломано.

Sub Search_Month()

    Dim datasheet As Worksheet
    Set datasheet = Sheet2
    Dim Mreport As Worksheet
    Set Mreport = Sheet9

    Dim Lmonth As Integer
    Search = Range("m4").Value

    Dim i As Integer

    Mreport.Unprotect Password:=rapid1

    Mreport.Range("a2:a300").ClearContents

    datasheet.Activate

    For i = 7 To 5000

        Lmonth = Month(Cells(i, 6))

        If Lmonth = Search Then

            Range(Cells(i, 2), Cells(i + 3, 2)).Copy
            Mreport.Activate
            Range("A1000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            datasheet.Activate

        End If

    Next i

    Mreport.Activate

    Mreport.Protect Password:=rapid1

    MsgBox "End of Month Report Updated"

End Sub

Строка, помечающаяLmonth = Month (Cells (i, 6)), но я не знаю почему.

Все результаты, найденные макросом, верны, просто ошибка в конце раздражает.Я думаю, что говорится: «следующая строка поиска не показывает lmonth = 1, поэтому я больше не могу запустить код, поэтому он должен быть взломан» *

Ответы [ 3 ]

0 голосов
/ 15 февраля 2019

Копировать ежемесячно

  • Я изменил переменную rapid1 на строку.Возможно, вы захотите изменить это, чтобы заставить код работать.
  • Хотя реализация констант (изменяющихся только один раз и быстрое изменение «в одном месте» (в начале)) и присвоение им соответствующих имен, вероятно, увеличивает читабельность для других (и для вас, через некоторое время), это может быть не так при разработке.Поэтому я включил Версия без констант ниже Основная версия .

Основная версия

Sub Search_Month()

    ' Data
    Const cSearch As String = "M4"  ' Search Value Cell Range
    Const cFRD As Long = 7          ' First Row Number
    Const cOffset As String = 3     ' Copy Row Offset
    Const cCol As Variant = "F"     ' Search Column Letter/Number
    Const cCopy As Variant = "B"    ' Copy Column Letter/Number
    ' Report
    Const cFRR As Long = 2          ' First Row Number
    Const cWrite As Variant = "A"   ' Write Column Letter/Number
    ' Data
    Dim datasheet As Worksheet  ' Worksheet
    Dim rng As Range            ' Last Cell Range
    Dim Search As Long          ' Search Month
    Dim vntMonth As Variant     ' Current Month
    Dim i As Long               ' Row Counter
    ' Report
    Dim Mreport As Worksheet    ' Worksheet
    Dim FER As Long             ' First Empty Row

    ' Create References to Worksheets
    Set datasheet = Sheet2
    Set Mreport = Sheet9

    ' Speed up
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
    On Error GoTo ProcedureExit

    ' In Data Worksheet
    With datasheet

        ' Assign value from Search Value Cell Range to Search Month.
        Search = .Range(cSearch).Value

        ' In Search Column
        With .Columns(cCol)
            ' Calculate Last Cell Range in Search Column.
            Set rng = .Find("*", , xlFormulas, xlWhole, xlByColumns, xlPrevious)
        End With

        If rng Is Nothing Then ' No data in column (Highly unlikely).
            MsgBox "No Data in column '" _
                    & Split(.Cells(1, cCol).Address, "$")(1) & "'."
            GoTo ProcedureExit
        End If

        ' In Report Worksheet
        With Mreport
            .Unprotect Password:="rapid1"
            ' Clear contents from First Row to bottom cell of Write Column.
            .Cells(cFRR, cWrite).Resize(.Rows.Count - cFRR + 1).ClearContents
            ' Write First Row Number to First Empty Row.
            FER = cFRR
        End With

        ' Loop through cells of Data Worksheet.
        For i = cFRD To rng.Row
            ' Write value of current cell to Current Month.
            vntMonth = .Cells(i, cCol)
            ' Check if Current Month is a date or can be converted to a date.
            If IsDate(vntMonth) Then
                ' Check if month of current cell value is equal to Current Month.
                If Month(vntMonth) = Search Then
                    ' Write data from Data Worksheet to Report Worksheet.
                    Mreport.Cells(FER, cWrite).Resize(cOffset) = _
                            .Cells(i, cCopy).Resize(cOffset).Value
                    FER = FER + cOffset
                End If
            End If
        Next
    End With

    ' In Report Worksheet
    With Mreport
        .Protect Password:="rapid1"
        MsgBox "End of Month Report Updated"
    End With

ProcedureExit:

    ' Speed down
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With

End Sub

Версия без констант

Sub Search_Month_No_Constants()

    ' Data
    Dim datasheet As Worksheet  ' Worksheet
    Dim rng As Range            ' Last Cell Range
    Dim Search As Long          ' Search Month
    Dim vntMonth As Variant     ' Current Month
    Dim i As Long               ' Row Counter
    ' Report
    Dim Mreport As Worksheet    ' Worksheet
    Dim FER As Long             ' First Empty Row

    ' Create References to Worksheets
    Set datasheet = Sheet2
    Set Mreport = Sheet9

    ' Speed up
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
    On Error GoTo ProcedureExit

    ' In Data Worksheet
    With datasheet

        ' Assign value from Search Value Cell Range to Search Month.
        Search = .Range("M4").Value

        ' In Search Column
        With .Columns("F")
            ' Calculate Last Cell Range in Search Column.
            Set rng = .Find("*", , xlFormulas, xlWhole, xlByColumns, xlPrevious)
        End With

        If rng Is Nothing Then ' No data in column (Highly unlikely).
            MsgBox "No Data in column 'F'." _
            GoTo ProcedureExit
        End If

        ' In Report Worksheet
        With Mreport
            .Unprotect Password:="rapid1"
            ' Clear contents from First Row to bottom cell of Write Column.
            .Cells(2, "A").Resize(.Rows.Count - 2 + 1).ClearContents
            ' Write First Row Number to First Empty Row.
            FER = 2
        End With

        ' Loop through cells of Data Worksheet.
        For i = 7 To rng.Row
            ' Write value of current cell to Current Month.
            vntMonth = .Cells(i, "F")
            ' Check if Current Month is a date or can be converted to a date.
            If IsDate(vntMonth) Then
                ' Check if month of current cell value is equal to Current Month.
                If Month(vntMonth) = Search Then
                    ' Write data from Data Worksheet to Report Worksheet.
                    Mreport.Cells(FER, "A").Resize(3) = _
                            .Cells(i, "B").Resize(3).Value
                    FER = FER + 3
                End If
            End If
        Next
    End With

    ' In Report Worksheet
    With Mreport
        .Protect Password:="rapid1"
        MsgBox "End of Month Report Updated"
    End With

ProcedureExit:

    ' Speed down
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With

End Sub
0 голосов
/ 18 февраля 2019

ну, это стыдно ...

Я попробовал многие из ваших вариантов выше, но безрезультатно, затем я вставил что-то в мой код, и он вставил номер задания, который, как мне показалось, был странным, но былна самом деле работа не о том, где код сломался.Итак, я пошел посмотреть на это поле и обнаружил, что я ввел дату для этого поля как 07/02/19 /, конечный прерыватель пересылки выдал ошибку кода.

Удалил / и повторно запустил коди он работал отлично, без ошибок отладки.

Спасибо всем за вашу помощь и советы, я буду использовать ваше кодирование и отзывы для улучшения этого кода и еще много в будущем

Большое спасибо еще раз!

rookieerror!

0 голосов
/ 15 февраля 2019

Ошибка отладки 13 - несоответствие типов.Поэтому функции «Месяц» присваивается значение, которое не может быть обработано.

См. Документация для справки.Это должна быть дата.

Ваша главная проблема - факт, что вы просто переходите со строки 7 на 5000, даже не проверяя, есть ли контент.Я не думаю, что вы можете доверять тому факту, что в таблице всегда есть 4993 записи.

Поэтому я рекомендую изменить цикл на что-то вроде For i = 7 To ActiveSheet.UsedRange.Rows.Count.Также вы можете проверить тип данных перед использованием «Month ()» с функцией « IsDate » - если вы не уверены.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...