Aide sur dictionary

Option Explicit
Const Col As String * 1 = "C" ' à adapter
'-------
Sub Decompter_par_pays()
Dim Derlig As Long, Idx As Long 'à adapter type svt nbre lignes
Dim T_out()
Dim D_fax As Object, Pays As String, Sur_x As Long '(type sur_x à adapter)

     'initialisations
     Application.ScreenUpdating = False
     Derlig = Columns("C").Find("*", , , , , xlPrevious).Row - 2
      ' mémorisation en mémoire ram du tableau (t_out)
     T_out = Range("B2:C" & Derlig)
     Set D_fax = CreateObject("Scripting.Dictionary")
     
     'affectations des décomptes par pays
     For Idx = 1 To UBound(T_out) Step 4
          Pays = T_out(Idx, 2)
          Sur_x = Application.CountIf(Columns(Col), Pays)
          If Not D_fax.Exists(Pays) Then
               D_fax.Add Pays, 1
               T_out(Idx, 1) = 1 & " sur " & Sur_x
          Else
               D_fax.Item(Pays) = D_fax.Item(Pays) + 1
               T_out(Idx, 1) = D_fax.Item(Pays) & " sur " & Sur_x
          End If
     Next
     
     'restitution
     Range("E2").Resize(UBound(T_out), 2) = T_out ' E2 à adapter pour vérif procédure et à supprimer si OK
     'Range("B2").Resize(UBound(T_out), 2) =  T_out      B2 'à adapter et a activer après vérif OK
End Sub

Option Explicit
'-------
Sub Decompter_par_pays()
Dim Derlig As Integer, Idx As Integer  'nbre lignes estimées à 30000
Dim T_pays(), T_nbre()
Dim D_fax As Object, Pays As String, Sur_x As Byte '

'--------initialisations
     Application.ScreenUpdating = False
     'effacement cellule fusionnées
     With Columns("A:D")
          .MergeCells = False
          .HorizontalAlignment = xlCenterAcrossSelection
     End With
     ' mémorisation en mémoire ram des tableaux (T_pays,T_nbre)
     Derlig = Columns("C").Find("ZONE", , , , , xlPrevious).Row + 4
      T_pays = Application.Transpose(Range("C5:C" & Derlig))
     T_nbre = Application.Transpose(Range("B5:B" & Derlig))
     'instantation dictionary
     Set D_fax = CreateObject("Scripting.Dictionary")
     
'-------------affectations des décomptes par pays
     For Idx = 1 To UBound(T_pays)
          If T_pays(Idx) = "ZONE" Then
               Idx = Idx + 4
               Pays = T_pays(Idx)
               Sur_x = Application.CountIf(Columns("C"), Pays)
               If Not D_fax.Exists(Pays) Then
                    D_fax.Add Pays, 1
               Else
                    D_fax.Item(Pays) = D_fax.Item(Pays) + 1
               End If
                T_nbre(Idx) = D_fax.Item(Pays) & " sur " & Sur_x
          End If
     Next
     
'--------'restitution
     Range("E5").Resize(UBound(T_nbre), 1) = Application.Transpose(T_nbre) 'remplacer E5 par B5 après essais
End Sub