Ошибка выполнения VBA 1004 «Ошибка приложения или объекта» при использовании Range.Offset - PullRequest
0 голосов
/ 29 января 2020

У меня проблема с ошибкой времени выполнения 1004 «Ошибка приложения или объекта» при выборе диапазона с помощью Range.Offset. Многие мои коды содержат If и ElseIf, и я только изменил значения, даже не трогал коды. VBA работал нормально, прежде чем я изменил значения в IF заявлениях. Теперь он продолжает давать мне сообщение об ошибке выполнения.

Вот мои коды. Хотя они очень длинные.

Sub compare2()

Dim i As Long
Dim A As Long
Dim B As Long
Dim c As Long

A = 14
B = 15
c = 16



Do While A <= 42
    i = 2
    Do Until Len(Cells(i, A)) = 0

        If Cells(i, A) = "Green" And Cells(i, B) = "Rollup" Then
        Cells(i, c) = "Green"

        ElseIf Cells(i, A) = "Green" And Cells(i, B) = "Green" Then
        Cells(i, c) = "Green"

        ElseIf Cells(i, A) = "Green" And Cells(i, B) = "Yellow" Then
        Cells(i, c) = "Yellow"

        ElseIf Cells(i, A) = "Green" And Cells(i, B) = "Red" Then
        Cells(i, c) = "Red"

        ElseIf Cells(i, A) = "Green" And Cells(i, B) = "Overdue" Then
        Cells(i, c) = "Overdue"



        ElseIf Cells(i, A) = "Yellow" And Cells(i, B) = "Rollup" Then
        Cells(i, c) = "Yellow"

        ElseIf Cells(i, A) = "Yellow" And Cells(i, B) = "Green" Then
        Cells(i, c) = "Yellow"

        ElseIf Cells(i, A) = "Yellow" And Cells(i, B) = "Yellow" Then
        Cells(i, c) = "Yellow"

        ElseIf Cells(i, A) = "Yellow" And Cells(i, B) = "Red" Then
        Cells(i, c) = "Red"

        ElseIf Cells(i, A) = "Yellow" And Cells(i, B) = "Overdue" Then
        Cells(i, c) = "Overdue"



        ElseIf Cells(i, A) = "Red" And Cells(i, B) = "Rollup" Then
        Cells(i, c) = "Red"

        ElseIf Cells(i, A) = "Red" And Cells(i, B) = "Green" Then
        Cells(i, c) = "Red"

        ElseIf Cells(i, A) = "Red" And Cells(i, B) = "Yellow" Then
        Cells(i, c) = "Red"

        ElseIf Cells(i, A) = "Red" And Cells(i, B) = "Red" Then
        Cells(i, c) = "Red"

        ElseIf Cells(i, A) = "Red" And Cells(i, B) = "Overdue" Then
        Cells(i, c) = "Overdue"



        ElseIf Cells(i, A) = "Rollup" And Cells(i, B) = "Rollup" Then
        Cells(i, c) = "Rollup"

        ElseIf Cells(i, A) = "Rollup" And Cells(i, B) = "Green" Then
        Cells(i, c) = "Green"

        ElseIf Cells(i, A) = "Rollup" And Cells(i, B) = "Yellow" Then
        Cells(i, c) = "Yellow"

        ElseIf Cells(i, A) = "Rollup" And Cells(i, B) = "Red" Then
        Cells(i, c) = "Red"

        ElseIf Cells(i, A) = "Rollup" And Cells(i, B) = "Overdue" Then
        Cells(i, c) = "Overdue"



        ElseIf Cells(i, A) = "Available" And Cells(i, B) = "Rollup" Then
        Cells(i, c) = "Available"

        ElseIf Cells(i, A) = "Available" And Cells(i, B) = "Green" Then
        Cells(i, c) = "Available"

        ElseIf Cells(i, A) = "Available" And Cells(i, B) = "Yellow" Then
        Cells(i, c) = "Available"

        ElseIf Cells(i, A) = "Available" And Cells(i, B) = "Red" Then
        Cells(i, c) = "Available"

        ElseIf Cells(i, A) = "Available" And Cells(i, B) = "Overdue" Then
        Cells(i, c) = "Overdue"



        ElseIf Cells(i, A) = "Outside" And Cells(i, B) = "Rollup" Then
        Cells(i, c) = "Outside"

         ElseIf Cells(i, A) = "Outside" And Cells(i, B) = "Green" Then
        Cells(i, c) = "Outside"

        ElseIf Cells(i, A) = "Outside" And Cells(i, B) = "Yellow" Then
        Cells(i, c) = "Outside"

        ElseIf Cells(i, A) = "Outside" And Cells(i, B) = "Red" Then
        Cells(i, c) = "Outside"



        ElseIf Cells(i, A) = "Podding" And Cells(i, B) = "Rollup" Then
        Cells(i, c) = "Rollup"



        ElseIf Cells(i, A) = "Title Transfer" And Cells(i, B) = "Rollup" Then
        Cells(i, c) = "Title Transfer"

        ElseIf Cells(i, A) = "Title Transfer" And Cells(i, B) = "Green" Then
        Cells(i, c) = "Title Transfer"

        ElseIf Cells(i, A) = "Title Transfer" And Cells(i, B) = "Yellow" Then
        Cells(i, c) = "Title Transfer"

        ElseIf Cells(i, A) = "Title Transfer" And Cells(i, B) = "Red" Then
        Cells(i, c) = "Title Transfer"

        ElseIf Cells(i, A) = "Title Transfer" And Cells(i, B) = "Overdue" Then
        Cells(i, c) = "Overdue"



        ElseIf Cells(i, A) = " " And Cells(i, B) = " " Then
        Cells(i, c) = " "

        Else


        End If
        i = i + 1
    Loop



    A = A + 4
    B = A + 1
    c = A + 2
Loop


End Sub

Второй:

Public Sub single_change(changed_cell As Range)


    Dim sales_cell As Range
    Dim production_cell As Range
    Dim day_cell As Range

    If changed_cell.Column Mod 2 = 0 Then
        Set sales_cell = changed_cell
        Set production_cell = changed_cell.Offset(, 1)
        Set day_cell = production_cell.Offset(, 1)
    Else
        Set production_cell = changed_cell
        Set sales_cell = changed_cell.Offset(, -1)
        Set day_cell = production_cell.Offset(, 1)
    End If


    On Error GoTo multiple_changes

    If sales_cell = "Green" And production_cell = "Rollup" Then
        day_cell = "Green"

        ElseIf sales_cell = "Green" And production_cell = "Green" Then
        day_cell = "Green"

        ElseIf sales_cell = "Green" And production_cell = "Yellow" Then
       day_cell = "Yellow"

        ElseIf sales_cell = "Green" And production_cell = "Red" Then
        day_cell = "Red"

        ElseIf sales_cell = "Green" And production_cell = "Overdue" Then
       day_cell = "Overdue"



        ElseIf sales_cell = "Yellow" And production_cell = "Rollup" Then
        day_cell = "Yellow"

        ElseIf sales_cell = "Yellow" And production_cell = "Green" Then
        day_cell = "Yellow"

        ElseIf sales_cell = "Yellow" And production_cell = "Yellow" Then
        day_cell = "Yellow"

        ElseIf sales_cell = "Yellow" And production_cell = "Red" Then
        day_cell = "Red"

        ElseIf sales_cell = "Yellow" And production_cell = "Overdue" Then
        day_cell = "Overdue"



        ElseIf sales_cell = "Red" And production_cell = "Rollup" Then
        day_cell = "Red"

        ElseIf sales_cell = "Red" And production_cell = "Green" Then
        day_cell = "Red"

        ElseIf sales_cell = "Red" And production_cell = "Yellow" Then
       day_cell = "Red"

        ElseIf sales_cell = "Red" And production_cell = "Red" Then
        day_cell = "Red"

        ElseIf sales_cell = "Red" And production_cell = "Overdue" Then
        day_cell = "Overdue"



        ElseIf sales_cell = "Rollup" And production_cell = "Rollup" Then
        day_cell = "Rollup"

        ElseIf sales_cell = "Rollup" And production_cell = "Green" Then
        day_cell = "Green"

        ElseIf sales_cell = "Rollup" And production_cell = "Yellow" Then
        day_cell = "Yellow"

        ElseIf sales_cell = "Rollup" And production_cell = "Red" Then
        day_cell = "Red"

        ElseIf sales_cell = "Rollup" And production_cell = "Overdue" Then
        day_cell = "Overdue"



        ElseIf sales_cell = "Available" And production_cell = "Rollup" Then
        day_cell = "Available"

        ElseIf sales_cell = "Available" And production_cell = "Green" Then
        day_cell = "Available"

        ElseIf sales_cell = "Available" And production_cell = "Yellow" Then
        day_cell = "Available"

        ElseIf sales_cell = "Available" And production_cell = "Red" Then
        day_cell = "Available"

        ElseIf sales_cell = "Available" And production_cell = "Overdue" Then
        day_cell = "Overdue"



        ElseIf sales_cell = "Outside" And production_cell = "Rollup" Then
        day_cell = "Outside"

        ElseIf sales_cell = "Outside" And production_cell = "Green" Then
        day_cell = "Outside"

        ElseIf sales_cell = "Outside" And production_cell = "Yellow" Then
        day_cell = "Outside"

        ElseIf sales_cell = "Outside" And production_cell = "Red" Then
        day_cell = "Outside"



        ElseIf sales_cell = "Podding" And production_cell = "Rollup" Then
        day_cell = "Rollup"



        ElseIf sales_cell = "Title Transfer" And production_cell = "Rollup" Then
        day_cell = "Title Transfer"

        ElseIf sales_cell = "Title Transfer" And production_cell = "Green" Then
        day_cell = "Title Transfer"

        ElseIf sales_cell = "Title Transfer" And production_cell = "Yellow" Then
        day_cell = "Title Transfer"

        ElseIf sales_cell = "Title Transfer" And production_cell = "Red" Then
       day_cell = "Title Transfer"

        ElseIf sales_cell = "Title Transfer" And production_cell = "Overdue" Then
        day_cell = "Overdue"



        ElseIf sales_cell = " " And production_cell = " " Then
        day_cell = " "


        Else

        End If

        Exit Sub

multiple_changes:

Dim i As Long
Dim A As Long
Dim B As Long
Dim c As Long

A = 14
B = 15
c = 16



Do While A <= 42
    i = 2
    Do Until Len(Cells(i, A)) = 0

        If Cells(i, A) = "Green" And Cells(i, B) = "Rollup" Then
        Cells(i, c) = "Green"

        ElseIf Cells(i, A) = "Green" And Cells(i, B) = "Green" Then
        Cells(i, c) = "Green"

        ElseIf Cells(i, A) = "Green" And Cells(i, B) = "Yellow" Then
        Cells(i, c) = "Yellow"

        ElseIf Cells(i, A) = "Green" And Cells(i, B) = "Red" Then
        Cells(i, c) = "Red"

        ElseIf Cells(i, A) = "Green" And Cells(i, B) = "Overdue" Then
        Cells(i, c) = "Overdue"



        ElseIf Cells(i, A) = "Yellow" And Cells(i, B) = "Rollup" Then
        Cells(i, c) = "Yellow"

        ElseIf Cells(i, A) = "Yellow" And Cells(i, B) = "Green" Then
        Cells(i, c) = "Yellow"

        ElseIf Cells(i, A) = "Yellow" And Cells(i, B) = "Yellow" Then
        Cells(i, c) = "Yellow"

        ElseIf Cells(i, A) = "Yellow" And Cells(i, B) = "Red" Then
        Cells(i, c) = "Red"

        ElseIf Cells(i, A) = "Yellow" And Cells(i, B) = "Overdue" Then
        Cells(i, c) = "Overdue"



        ElseIf Cells(i, A) = "Red" And Cells(i, B) = "Rollup" Then
        Cells(i, c) = "Red"

        ElseIf Cells(i, A) = "Red" And Cells(i, B) = "Green" Then
        Cells(i, c) = "Red"

        ElseIf Cells(i, A) = "Red" And Cells(i, B) = "Yellow" Then
        Cells(i, c) = "Red"

        ElseIf Cells(i, A) = "Red" And Cells(i, B) = "Red" Then
        Cells(i, c) = "Red"

        ElseIf Cells(i, A) = "Red" And Cells(i, B) = "Overdue" Then
        Cells(i, c) = "Overdue"



        ElseIf Cells(i, A) = "Rollup" And Cells(i, B) = "Rollup" Then
        Cells(i, c) = "Rollup"

        ElseIf Cells(i, A) = "Rollup" And Cells(i, B) = "Green" Then
        Cells(i, c) = "Green"

        ElseIf Cells(i, A) = "Rollup" And Cells(i, B) = "Yellow" Then
        Cells(i, c) = "Yellow"

        ElseIf Cells(i, A) = "Rollup" And Cells(i, B) = "Red" Then
        Cells(i, c) = "Red"

        ElseIf Cells(i, A) = "Rollup" And Cells(i, B) = "Overdue" Then
        Cells(i, c) = "Overdue"



        ElseIf Cells(i, A) = "Available" And Cells(i, B) = "Rollup" Then
        Cells(i, c) = "Available"

        ElseIf Cells(i, A) = "Available" And Cells(i, B) = "Green" Then
        Cells(i, c) = "Available"

        ElseIf Cells(i, A) = "Available" And Cells(i, B) = "Yellow" Then
        Cells(i, c) = "Available"

        ElseIf Cells(i, A) = "Available" And Cells(i, B) = "Red" Then
        Cells(i, c) = "Available"

        ElseIf Cells(i, A) = "Available" And Cells(i, B) = "Overdue" Then
        Cells(i, c) = "Overdue"



         ElseIf Cells(i, A) = "Outside" And Cells(i, B) = "Rollup" Then
        Cells(i, c) = "Outside"

        ElseIf Cells(i, A) = "Outside" And Cells(i, B) = "Green" Then
        Cells(i, c) = "Outside"

        ElseIf Cells(i, A) = "Outside" And Cells(i, B) = "Yellow" Then
        Cells(i, c) = "Outside"

        ElseIf Cells(i, A) = "Outside" And Cells(i, B) = "Red" Then
        Cells(i, c) = "Outside"



        ElseIf Cells(i, A) = "Podding" And Cells(i, B) = "Rollup" Then
        Cells(i, c) = "Rollup"



        ElseIf Cells(i, A) = "Title Transfer" And Cells(i, B) = "Rollup" Then
        Cells(i, c) = "Title Transfer"

        ElseIf Cells(i, A) = "Title Transfer" And Cells(i, B) = "Green" Then
        Cells(i, c) = "Title Transfer"

        ElseIf Cells(i, A) = "Title Transfer" And Cells(i, B) = "Yellow" Then
        Cells(i, c) = "Title Transfer"

        ElseIf Cells(i, A) = "Title Transfer" And Cells(i, B) = "Red" Then
        Cells(i, c) = "Title Transfer"

        ElseIf Cells(i, A) = "Title Transfer" And Cells(i, B) = "Overdue" Then
        Cells(i, c) = "Overdue"



        ElseIf Cells(i, A) = " " And Cells(i, B) = " " Then
        Cells(i, c) = " "

        Else


        End If
        i = i + 1

        Loop



    A = A + 4
    B = A + 1
    c = A + 2

    Loop

End Sub

Я не уверен, почему мои бывшие коллеги повторяют эти условия If и ElseIf много раз , Пожалуйста, посоветуйте мне, как я могу улучшить эти коды.

Кроме того, когда я нажимал отладку, Set sales_cell = changed_cell.Offset(, -1) во 2-м пакете продолжал выделяться.

Дополнительная информация: мой sales_cell - 14-й столбец (столбец N), production_cell - 15-й столбец (столбец O).

Это то, что у меня есть на листе, который должен использовать макрос:

Private Sub Worksheet_Change(ByVal Target As Range)

    Call Module1.single_change(Target)

End Sub

Вот как должен работать макрос (но это не так). У меня есть набор из 4 смежных столбцов: Столбец N (или Продажи), Столбец O (или Производство), Столбец P (известный как День №) и Столбец Q (известный как Статус). как это работает, независимо от того, что пользователь вводит / изменяет в столбце N (продажи) и столбце M (производство), макрос возвращает соответствующее значение из операторов If. То же самое относится и к следующим 4 колонкам и т. Д.

Любая помощь очень ценится. Я застрял с этой проблемой в течение нескольких дней и до сих пор не знаю, в чем проблема на самом деле.

Спасибо!

1 Ответ

0 голосов
/ 29 января 2020

Выглядит так, как будто вы называете это всякий раз, когда в вашей рабочей книге изменяется ЛЮБАЯ ячейка.
Затем он пытается запустить код для этой измененной ячейки и ячеек рядом с ней.
Это означает, что если вы что-то изменили в столбце Это повлияет на столбцы B, B, C и D.

Если мы обновим его, изменим его только при изменении столбца N / R / V или O / S / W или любых повторяющихся столбцов после этого , то вы больше не должны получать сообщение об ошибке.

Попробуйте обновить все "single_change" до:

Public Sub single_change(changed_cell As Range)

Dim sales_cell As Range
Dim production_cell As Range
Dim day_cell As Range
Dim col_num as Integer

col_num = changed_cell.Column
If changed_cell.Column < 14 then 'Dont do anything before Col N
    Exit Sub
Else
    col_num = changed_cell.Column - 14
End if

If col_num  Mod 4 = 0 Then
    Set sales_cell = changed_cell
    Set production_cell = changed_cell.Offset(, 1)
    Set day_cell = production_cell.Offset(, 2)
ElseIf (col_num - 1)  Mod 4 = 0 Then
    Set sales_cell = changed_cell.Offset(, -1)
    Set production_cell = changed_cell
    Set day_cell = production_cell.Offset(, 1)
Else
    'Dont do anything between Col N,O and their repeated values
    Exit Sub
End If

If sales_cell = "Green" And production_cell = "Rollup" Then
    day_cell = "Green"
ElseIf sales_cell = "Green" And production_cell = "Green" Then
    day_cell = "Green"
ElseIf sales_cell = "Green" And production_cell = "Yellow" Then
   day_cell = "Yellow"
ElseIf sales_cell = "Green" And production_cell = "Red" Then
    day_cell = "Red"
ElseIf sales_cell = "Green" And production_cell = "Overdue" Then
   day_cell = "Overdue"
ElseIf sales_cell = "Yellow" And production_cell = "Rollup" Then
    day_cell = "Yellow"
ElseIf sales_cell = "Yellow" And production_cell = "Green" Then
    day_cell = "Yellow"
ElseIf sales_cell = "Yellow" And production_cell = "Yellow" Then
    day_cell = "Yellow"
ElseIf sales_cell = "Yellow" And production_cell = "Red" Then
    day_cell = "Red"
ElseIf sales_cell = "Yellow" And production_cell = "Overdue" Then
    day_cell = "Overdue"
ElseIf sales_cell = "Red" And production_cell = "Rollup" Then
    day_cell = "Red"
ElseIf sales_cell = "Red" And production_cell = "Green" Then
    day_cell = "Red"
ElseIf sales_cell = "Red" And production_cell = "Yellow" Then
   day_cell = "Red"
ElseIf sales_cell = "Red" And production_cell = "Red" Then
    day_cell = "Red"
ElseIf sales_cell = "Red" And production_cell = "Overdue" Then
    day_cell = "Overdue"
ElseIf sales_cell = "Rollup" And production_cell = "Rollup" Then
    day_cell = "Rollup"
ElseIf sales_cell = "Rollup" And production_cell = "Green" Then
    day_cell = "Green"
ElseIf sales_cell = "Rollup" And production_cell = "Yellow" Then
    day_cell = "Yellow"
ElseIf sales_cell = "Rollup" And production_cell = "Red" Then
    day_cell = "Red"
ElseIf sales_cell = "Rollup" And production_cell = "Overdue" Then
    day_cell = "Overdue"
ElseIf sales_cell = "Available" And production_cell = "Rollup" Then
    day_cell = "Available"
ElseIf sales_cell = "Available" And production_cell = "Green" Then
    day_cell = "Available"
ElseIf sales_cell = "Available" And production_cell = "Yellow" Then
    day_cell = "Available"
ElseIf sales_cell = "Available" And production_cell = "Red" Then
    day_cell = "Available"
ElseIf sales_cell = "Available" And production_cell = "Overdue" Then
    day_cell = "Overdue"
ElseIf sales_cell = "Outside" And production_cell = "Rollup" Then
    day_cell = "Outside"
ElseIf sales_cell = "Outside" And production_cell = "Green" Then
    day_cell = "Outside"
ElseIf sales_cell = "Outside" And production_cell = "Yellow" Then
    day_cell = "Outside"
ElseIf sales_cell = "Outside" And production_cell = "Red" Then
    day_cell = "Outside"
ElseIf sales_cell = "Podding" And production_cell = "Rollup" Then
    day_cell = "Rollup"
ElseIf sales_cell = "Title Transfer" And production_cell = "Rollup" Then
    day_cell = "Title Transfer"
ElseIf sales_cell = "Title Transfer" And production_cell = "Green" Then
    day_cell = "Title Transfer"
ElseIf sales_cell = "Title Transfer" And production_cell = "Yellow" Then
    day_cell = "Title Transfer"
ElseIf sales_cell = "Title Transfer" And production_cell = "Red" Then
   day_cell = "Title Transfer"
ElseIf sales_cell = "Title Transfer" And production_cell = "Overdue" Then
    day_cell = "Overdue"
ElseIf sales_cell = " " And production_cell = " " Then
    day_cell = " "
Else
    'Do nothing
End If
End Sub

Надеюсь, что поможет:)

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