"Использовать необходимо формулы, так как на работе excel 2003" - не вижу логической связи :)  
Но вижу, как это можно сделать макросом - на словаре (или коллекции) в словаре.  
Ну раз "необходимо формулы" - я пас...

Я думаю, формулами это трудно сделать. А если данных много - то и тяжело :(  
Но я в формулах не специалист...  
Макросом тоже не десяток строк, и код будет не для начинающих.  
Чуть позже посмотрю, что можно сделать.

<<- в данных ячейках будут дальнейшие вычисления>>  
 
Значит там, где есть страны формулу написать уже нельзя.  
Либо другая структура, либо макрос от Hugo.

Макрос. Для сравнения с примером выгружаю в 16, 17 столбцы - это можно подправить как нужно.  
Заливки цветом нет - но можно добавить.  
 
 
Option Explicit  
 
Sub StraniKodi()    ' словарь в словаре  
   Dim a, cArr, i&, t$, Dic As Object  
   Dim el, lr&  
 
   a = Range("B3", Cells(Rows.Count, "A").End(xlUp)).Value  
   Set Dic = CreateObject("Scripting.Dictionary")  
   With Dic  
       .CompareMode = 1  
       For i = 1 To UBound(a)  
           t = a(i, 2)  
           If Not .exists(t) Then .Add t, CreateObject("Scripting.Dictionary")  
           .Item(t).Item(Format(a(i, 1), "00000")) = 0&  
       Next  
   End With  
 
   cArr = Dic.keys: SortArray cArr  
 
   lr = 3  
   For Each el In cArr  
       Cells(lr, 17) = el: lr = lr + 1  
       a = Dic.Item(el).keys: SortArray a  
       With Cells(lr, 16).Resize(UBound(a) + 1, 1)  
           .NumberFormat = "00000"  
           .Value = Application.Transpose(a)  
       End With  
       lr = lr + UBound(a) + 1  
   Next  
 
End Sub  
 
 
Private Sub SortArray(ByRef a As Variant)  
   Dim i As Long, j As Long  
   Dim t As Variant  
 
   'standard bubble sort loops  
   For i = LBound(a) To UBound(a) - 1  
       For j = i + 1 To UBound(a)  
           If a(i) > a(j) Then    'change to < for descending order  
               t = a(i)  
               a(i) = a(j)  
               a(j) = t  
           End If  
       Next j  
   Next i  
End Sub