Нумерация значений в ячейке при совпадении.

[Aleksandr H.]

может есть и более изящный способ

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Dim TextCount As Integer
    Dim i As Integer
    Dim Count As Integer
    Dim text As String
    On Error GoTo Erl
    Application.EnableEvents = False
    
    Set KeyCells = Range("B1:B100")
    
    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
        Is Nothing Then
        Count = 1
        For i = Target.Row - 1 To 1 Step -1
            If Trim$(Range("B" & i).Value2) <> "" Then
                text = Split(Trim$(Range("B" & i).Value2), " №")(0)
                If text = Target.Value2 Then
                    Count = Count + 1
                Else
                    Exit For
                End If
            End If
        Next i
        Select Case Count
            Case 1:
                Target.Value = Target.Value
            Case 2:
                Target.Offset(-1).Value = Target.Value & " № 1"
                Target.Value = Target.Value & " № " & Count
            Case Else
                Target.Value = Target.Value & " № " & Count
        End Select
        
        
    End If
Erl:
    Application.EnableEvents = True
End Sub

[krot12348]

Aleksandr H., Одним словом скажу, Красава. Мы тут голову ломаем, что то куда то пытаемся вставить, а оказалось все не правильно. Есть люди хорошие на этом свете, спасибо большое.