Private Sub Worksheet_Change(ByVal Target As Range)
    Dim d0_ As Range, d_ As Range
    Set d0_ = Intersect(Target, Range("B:B"))
    If Not d0_ Is Nothing Then
        Application.ScreenUpdating = 0
        For Each d_ In d0_
            With d_
                If .Value = "" Then
                    .Offset(, 1).Resize(1, 2).ClearContents
                Else
                    .Offset(, 1) = Date
                    t1_ = WorksheetFunction.VLookup(.Value, [орг], 2, 0)
                    t2_ = Format(Date, "\/MM\/YY\/")
                    t3_ = Format(WorksheetFunction.CountIf(Range("B:B"), .Value), "00")
                    .Offset(, 2) = t1_ & t2_ & t3_
                End If
            End With
        Next d_
        Range("C1:D1").EntireColumn.AutoFit
        Application.ScreenUpdating = 1
    End If
End Sub

t2_ = Format(Date, "\/MM\/YY\/")