Developing.ru

Код: Выделить всё

Function getId(Optional Start) As Long
'генератор последовательных значений
Static X As Long
  If IsMissing(Start) Then X = X + 1 Else X = Start - 1
  getId = X
End Function


Sub resetid()
'процедура сброса генератора в 1
  getId (1)
End Sub

Sub SaveId(ACell As Range, Width As Long)
'процедура сохранения индикатора справа от ячейки ACell в таблицу, шириной Width колонок
Dim i As Long
  Set ACell = ACell.Cells(1, 1)
  For i = 1 To Width
    If IsEmpty(ACell.Offset(0, i)) Then
      ACell.Offset(0, i).Value = getId()
      Exit For
    End If
  Next
End Sub



Private Sub Worksheet_Change(ByVal Target As Range)
'обработчик события Change на листе. Если интерактивно или 
'макросом меняются целевые ячейки, то она вписывает индикатор
  Select Case Target.Address(False, False)
    Case "B1", "B2", "B3", "B4", "B5", "B11", "B12", "B13", "B14", "B15"
       SaveId Target, 4
    Case "A1"
       resetid
  End Select
End Sub


Sub test()
'проверка работы всего этого хозяйства. 
'Впишем числа в целевые ячейки и посмотрим, что будет
  [b1] = 100
  [b2] = 101
  [b4] = 102
  [b1] = 103
  [b4] = 104
  [b3] = 105
End Sub

Код: Выделить всё

Private Sub Worksheet_Change(ByVal Target As Excel.Range) 'Excel 97-2003
   Dim iSource As Range
   Set iSource = Intersect(Target, [A2:A6])

   If Not iSource Is Nothing Then
      If Application.Count(iSource) > 0 Then '.CountA(iSource)
         Application.EnableEvents = False
         Cells(Target.Row, 256).End(xlToLeft)(1, 2) = Application.Max([B2:IV6]) + 1
         'Target.Range("IV1").End(xlToLeft)(1, 2) = Application.Max(Range("B2:IV6")) + 1
         Application.EnableEvents = True
      End If
   End If
End Sub