Excel: если нет данных, то макрос перестает считать

[telesh]

Если в столбце P есть данные, то макрос работает и рассчитывает формулы. Как только данные прекратились в столбце P, макрос перестаёт считать, так сказать в холостую считает.
Либо убрать нули из ячеек где нет данных.

Макрос

Sub Worksheet_SelectionChange(ByVal Target As Range)
For I = 1 To 10
P = Range("P" & 2 + I)
Q = Range("Q" & 2 + I)
O = Range("O" & 2 + I)
M = Range("M" & 2 + I)
Cells(2 + I, 2) = Int(P) 'округляет до целого числа
Cells(2 + I, 5) = Int(Q)

Cells(2 + I, 3) = Int(((P - Int(P)) * 10))
Cells(2 + I, 6) = Int(((Q - Int(Q)) * 10))
Cells(2 + I, 4) = (P * 10 - Int(P * 10)) * 100
Cells(2 + I, 7) = (Q * 10 - Int(Q * 10)) * 100
Cells(2 + I, 13) = Abs(P - Q)
Cells(2 + I, 14) = Application.RoundUp(M * 40, 0) 'Округляет вверх до целого числа
If (Range("O" & 2 + I) = "") Then
    If (Range("M" & 2 + I) > 0.0001) Then
        Cells(2 + I, 8).Value = "замазученность рельсов, повторяемости нет"
    End If
Else
    Cells(2 + I, 8).Value = "просадка прием отд стык, повторяемости нет"
End If
Next
End Sub

[свернуть]

[вложение удалено администратором]

[Администратор]

Почему вы решили использовать событие "Worksheet_SelectionChange"?
Это событие запускается, когда юзер просто щёлкает по ячейкам (то есть перемещает рамку-курсор).

[telesh]

Использовал Change  получилось так себе и в ячейке Q не считает формула а последнее условие где замазученость не работает.

Макрос

Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
     For I = 1 To 10
    Set rng = Range("P" & 2 + I)
    If Not Application.Intersect(rng, Range(Target.Address)) Is Nothing Then
        Application.EnableEvents = False
            P = Range("P" & 2 + I)
            Q = Range("Q" & 2 + I)
            O = Range("O" & 2 + I)
            M = Range("M" & 2 + I)
            Cells(2 + I, 2) = Int(P) '
            Cells(2 + I, 5) = Int(Q)

            Cells(2 + I, 3) = Int(((P - Int(P)) * 10))
            Cells(2 + I, 6) = Int(((Q - Int(Q)) * 10))
            Cells(2 + I, 4) = (P * 10 - Int(P * 10)) * 100
            Cells(2 + I, 7) = (Q * 10 - Int(Q * 10)) * 100
            Cells(2 + I, 13) = Abs(P - Q)
            Cells(2 + I, 14) = Application.RoundUp(M * 40, 0) 'Îêðóãëÿåò ââåðõ äî öåëîãî ÷èñëà
                    If (Range("O" & 2 + I) = "") Then
                        If (Range("M" & 2 + I) > 0.0001) Then
                            Cells(2 + I, 8).Value = "замазученость"
                        End If
                    Else
                        Cells(2 + I, 8).Value = "просадка"
                    End If
                 Application.EnableEvents = True
                 End If
      Next
End Sub

[свернуть]

[Администратор]

В "Worksheet_SelectionChange" вы Target не использовали и в "Worksheet_Change" тоже не используйте.
Просто при использовании "Worksheet_Change" макрос будет реже запускаться - только когда юзер будет делать изменения.

[telesh]

Использовал Target получилось из за многих условий три макроса. Их запихать в модуль или как то совместить чтобы все три макроса работали в событии Change
Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Application.EnableEvents = False
For I = 1 To 10
If Not (Intersect(Target, Range("P" & 2 + I)) Is Nothing And Intersect(Target, Range("Q" & 2 + I)) Is Nothing) Then
With Target
P = Range("P" & 2 + I)
Q = Range("Q" & 2 + I)
O = Range("O" & 2 + I)
Cells(2 + I, 2) = Int(P) 'îêðóãëÿåò äî öåëîãî ÷èñëà
Cells(2 + I, 5) = Int(Q)

Cells(2 + I, 3) = Int((((P - Int(P)) * 10)) + 1)
Cells(2 + I, 6) = Int((((Q - Int(Q)) * 10)) + 1)
Cells(2 + I, 4) = (P * 10 - Int(P * 10)) * 100
Cells(2 + I, 7) = (Q * 10 - Int(Q * 10)) * 100
Cells(2 + I, 13) = Abs(P - Q)
Cells(2 + I, 14) = Application.RoundUp((Range("M" & 2 + I)) * 40, 0)
    End With
  Application.EnableEvents = True
    End If
    Next
End Sub
Sub Worksheet_Change(ByVal Target As Range)
For I = 1 To 10
If Target.Count = 1 Then
Application.EnableEvents = False
        If Not (Intersect(Target, Range("O" & 2 + I)) Is Nothing And Intersect(Target, Range("M" & 2 + I)) Is Nothing) Then
If (Range("O" & 2 + I) = "") Then
    If (Range("M" & 2 + I) > 0.0001) Then
        Cells(2 + I, 8).Value = "çàìàçó÷åííîñòü ðåëüñîâ, ïîâòîðÿåìîñòè íåò"
    End If
Else
    Cells(2 + I, 8).Value = "ïðîñàäêà ïðèåì îòä ñòûê, ïîâòîðÿåìîñòè íåò"
End If
End If
  Application.EnableEvents = True
    End If
    Next
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
For I = 1 To 10
If Target.Count = 1 Then
        If Not (Intersect(Target, Range("O" & 2 + I)) Is Nothing And Intersect(Target, Range("P" & 2 + I)) Is Nothing) Then
            If Len(Range("O" & 2 + I).Value) * Len(Range("P" & 2 + I).Value) > 0 Then
                Application.EnableEvents = False
                Range("Q" & 2 + I).Value = Range("P" & 2 + I).Value
                Application.EnableEvents = True
            End If ' Len([R10].Value) * Len([S10].Value) > 0
        End If ' Not (Intersect(Target, [R10]) Is Nothing And Intersect(Target, [S10]) Is Nothing)
    End If ' Target.Count = 1
Next
End Sub

[вложение удалено администратором]

[Администратор]

Можете всё в одно событие "Worksheet_Change" записать - одно под другим. Макрос будет двигаться по событию "Worksheet_Change" сверху вниз и сначала будет делать верхний код, затем нижний.

Только я такой большой код не буду смотреть, вам надо будет специально для форума сделать код и по нему задать вопрос.

[telesh]

спасибо