Если в столбце 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"?
Это событие запускается, когда юзер просто щёлкает по ячейкам (то есть перемещает рамку-курсор).
Использовал 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" макрос будет реже запускаться - только когда юзер будет делать изменения.
Использовал 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" сверху вниз и сначала будет делать верхний код, затем нижний.
Только я такой большой код не буду смотреть, вам надо будет специально для форума сделать код и по нему задать вопрос.
спасибо