Исправление одного кода приводит к тому, что другой перестает работать - PullRequest
Новая
       22

Исправление одного кода приводит к тому, что другой перестает работать

0 голосов
/ 11 мая 2018

Я работаю над документом, в котором кликабельные ячейки помещают различные значения в столбец M на листах 1 и 3. На листе 1, когда столбец M читает как ПОЛНЫЙ, он будет вырезан из листа 1 и вставлен в лист 2, когда столбец M будет читать ЧАСТИЧНО HOLD, он будет вырезан из листа 1 и вставлен в лист 3. У меня много проблем с этим, но проблема, о которой я прошу помощи, заключается в том, что в следующем коде ходы будут работать, но я получаю «ошибку времени выполнения» '424' Требуется объект "и не принимает Time как объект в моей строке кода Target.Offset (, 4) .Value = Time, но когда я исправляю проблему в коде для интерактивных ячеек, строки больше не будут обрезаться и вставить.

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

    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngDest As Range, rngDest2 As Range, rngDest3 As Range
          If UCase(Target.Value) = "PARTIAL HOLD" Then
            Set rngDest = Sheet3.Range("A5:Q5")
            If Not Intersect(Target, Sheet1.Range("M5:M290")) Is Nothing Then
                Application.EnableEvents = False
                Target.EntireRow.Cut
                rngDest.Insert Shift:=xlDown
                Target.EntireRow.Delete
                Application.EnableEvents = True
            End If
        ElseIf UCase(Target.Value) = "PROGRESSING" Then
            Set rngDest3 = Sheet1.Range("A5:Q5")
            If Not Intersect(Sheet3.Cells(Target.Row, Target.Column), Sheet3.Range("M5:M290")) Is Nothing Then
                Application.EnableEvents = False
                Target.EntireRow.Cut
                rngDest3.Insert Shift:=xlDown
                Target.EntireRow.Delete
                Application.EnableEvents = True
            End If
        ElseIf UCase(Target.Value) = "COMPLETE" Then
            Set rngDest2 = Sheet2.Range("A5:Q5")
            If Not Intersect(Target, Sheet1.Range("M5:M290")) Is Nothing Then
                 Application.EnableEvents = False
                 Target.EntireRow.Cut
                 rngDest2.Insert Shift:=xlDown
                 Target.EntireRow.Delete
                 Application.EnableEvents = True
            End If
        End If
    End Sub


    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
       If Target.Column = 11 Then
          Cancel = True
          Target.Offset(, 2).Value = "IN PROGRESS"
          Target.Offset(, 4).Value = Time
       ElseIf Target.Column = 12 Then
          Cancel = True
          Target.Offset(, 1).Value = "COMPLETE"
          Target.Offset(, 4).Value = Time
       ElseIf Target.Column = 14 Then
          Cancel = True
          Target.Offset(, -1).Value = "PARTIAL HOLD"
       End If
    End Sub

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

    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngDest As Range, rngDest2 As Range, rngDest3 As Range
         If UCase(Target.Value) = "PARTIAL HOLD" Then
            Set rngDest = Sheet3.Range("A5:Q5")
            If Not Intersect(Target, Sheet1.Range("M5:M290")) Is Nothing Then
                Application.EnableEvents = False
                Target.EntireRow.Cut
                rngDest.Insert Shift:=xlDown
                Target.EntireRow.Delete
                Application.EnableEvents = True
            End If
        ElseIf UCase(Target.Value) = "PROGRESSING" Then
            Set rngDest3 = Sheet1.Range("A5:Q5")
            If Not Intersect(Sheet3.Cells(Target.Row, Target.Column), 
      Sheet3.Range("M5:M290")) Is Nothing Then
                Application.EnableEvents = False
                Target.EntireRow.Cut
                rngDest3.Insert Shift:=xlDown
                Target.EntireRow.Delete
                Application.EnableEvents = True
            End If
        ElseIf UCase(Target.Value) = "COMPLETE" Then
            Set rngDest2 = Sheet2.Range("A5:Q5")
            If Not Intersect(Target, Sheet1.Range("M5:M290")) Is Nothing Then
                 Application.EnableEvents = False
                 Target.EntireRow.Cut
                 rngDest2.Insert Shift:=xlDown
                 Target.EntireRow.Delete
                 Application.EnableEvents = True
           End If
        End If
    End Sub


    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Application.EnableEvents = False
    On Error GoTo Xit:
       If Target.Column = 11 Then
          Cancel = True
          Target.Offset(, 2).Value = "IN PROGRESS"
          Target.Offset(, 4).Value = Time
       ElseIf Target.Column = 12 Then
          Cancel = True
          Target.Offset(, 1).Value = "COMPLETE"
          Target.Offset(, 4).Value = Time
       ElseIf Target.Column = 14 Then
          Cancel = True
          Target.Offset(, -1).Value = "PARTIAL HOLD"
       End If
    Xit:
    Application.EnableEvents = True
    End Sub

Что я могу сделать, чтобы это исправить?

...