Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub Application.EnableEvents = 0 r1_ = Range("C" & Rows.Count).End(xlUp).Row If Not Intersect(Target, Range("C5:C" & r1_)) Is Nothing Then If Target = 1 Then m_ = WorksheetFunction.Max(Range("D5:D" & r1_)) If m_ < Range("A5") Then Target.Offset(, 1) = m_ + 1 Else Target = 0 End If Else If Target.Offset(, 1) Then Target.Offset(, 1) = 0 For i = 5 To r1_ If Range("D" & i) > Target.Offset(, 1) Then Range("D" & i) = Range("D" & i) - 1 End If Next i End If End If ElseIf Target.Address(0, 0) = "A5" Then For i = 5 To r1_ If Range("D" & i) > Target Then Range("C" & i).Resize(, 2) = 0 End If Next i End If Application.EnableEvents = 1 End Sub
[/vba]
Так нужно? [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub Application.EnableEvents = 0 r1_ = Range("C" & Rows.Count).End(xlUp).Row If Not Intersect(Target, Range("C5:C" & r1_)) Is Nothing Then If Target = 1 Then m_ = WorksheetFunction.Max(Range("D5:D" & r1_)) If m_ < Range("A5") Then Target.Offset(, 1) = m_ + 1 Else Target = 0 End If Else If Target.Offset(, 1) Then Target.Offset(, 1) = 0 For i = 5 To r1_ If Range("D" & i) > Target.Offset(, 1) Then Range("D" & i) = Range("D" & i) - 1 End If Next i End If End If ElseIf Target.Address(0, 0) = "A5" Then For i = 5 To r1_ If Range("D" & i) > Target Then Range("C" & i).Resize(, 2) = 0 End If Next i End If Application.EnableEvents = 1 End Sub
Спасибо, обе таблицы работают. Только krosav4ig, в твоей таблице не обнуляются введенные данные столбца Switch, если достигнуто максимальное значение активной нумерации.
Спасибо, обе таблицы работают. Только krosav4ig, в твоей таблице не обнуляются введенные данные столбца Switch, если достигнуто максимальное значение активной нумерации.imitsho