Индикация ввода данных?

[Maktub]

Возможно ли средствами VBA сделать индикацию ввода данных в ячейки? Например в одном столбце появляются данные посредством макроса, а во втором, третьем и четвертом цифры означающие порядковый номер появления данных. Картинку прикрепил.

[Naeel Maqsudov]

Легко

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

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

UPD:
При вводе значений в A1 счётчик сбрасывается и индикаторы снова начинаются с 1

[pashulka]

Если столбец A предполагается заполнять по одной ячейке, то можно также попробовать что-то вроде нижеприведенного кода,
правда там "ширина" таблицы индикации не ограничена тремя столбцами, ибо непонятно что должно произойти, когда количество вводов чисел превысит количество ячеек в этой таблице ...

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

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

[Maktub]

Большое спасибо, буду пробовать.
Не ожидал что так оперативно и так подробно мне ответят.А по поводу сброса значений попробую решить сам.