XL 2010 création array

Sub UnAutreTest()
Dim derlig As Long, t, i As Long, i1 As Long, s, x, dico, clef, n As Long
   'lecture du tableau des données sources
   With Sheets("sheet1")
      If .FilterMode Then .ShowAllData
      derlig = .Cells(Rows.Count, "a").End(xlUp).Row
      t = .Range("a3:c" & derlig).Value
 
      'dictionnaire des Numéros et des numéros de lignes associées
      Set dico = CreateObject("scripting.dictionary")
      For i = 2 To UBound(t)
         If Trim(t(i, 3)) <> "" Then
            s = Split(t(i, 3), ";")
            For Each x In s
               If Trim(x) <> "" Then
                  If Not dico.exists(x) Then dico.Add x, i Else dico(x) = dico(x) & " " & i
               End If
            Next x
         End If
      Next i
 
      'le tableau final
      ReDim res(1 To dico.Count + 1, 1 To 3)
      n = 1: res(n, 1) = t(1, 3): res(n, 2) = t(1, 2): res(n, 3) = t(1, 1):
      For Each clef In dico.keys
         n = n + 1: res(n, 1) = clef
         s = Split(dico(clef))
         For Each x In s
            res(n, 2) = Trim(res(n, 2) & " " & t(CLng(x), 2))
            res(n, 3) = Trim(res(n, 3) & " " & t(CLng(x), 1))
         Next x
      Next clef
 
      'affichage et formatage
      Application.ScreenUpdating = False
      Intersect(.Range("g3").CurrentRegion, .Rows("3:" & Rows.Count), .Columns("g:i")).Clear
      With .Range("g3").Resize(UBound(res), UBound(res, 2))
         .Value = res
         .Sort key1:=.Range("a1"), order1:=xlAscending, Header:=xlYes
         .Borders.LineStyle = xlContinuous
         .HorizontalAlignment = xlCenter
         .Rows(1).Font.Bold = True
         .Rows(1).Interior.Color = RGB(200, 200, 200)
         .Columns.EntireColumn.AutoFit
      End With
   End With
End Sub

Sub UnAutreTest()
Dim derlig As Long, t, i As Long, i1 As Long, s, x, dico, clef, n As Long
   With Sheets("sheet1")
      If .FilterMode Then .ShowAllData
      derlig = .Cells(Rows.Count, "a").End(xlUp).Row
      t = .Range("a3:c" & derlig).Value
  
      Set dico = CreateObject("scripting.dictionary")
      For i = 2 To UBound(t)
         If Trim(t(i, 3)) <> "" Then
            s = Split(t(i, 3), ";")
            For Each x In s
               If Trim(x) <> "" Then
                  If Not dico.exists(x) Then dico.Add x, i Else dico(x) = dico(x) & " " & i
               End If
            Next x
         End If
      Next i
  
      ReDim res(1 To dico.Count + 1, 1 To 3)
      n = 1: res(n, 1) = t(1, 3): res(n, 2) = t(1, 2): res(n, 3) = t(1, 1):
      For Each clef In dico.keys
         n = n + 1: res(n, 1) = clef
         s = Split(dico(clef))
         For Each x In s
            'res(n, 2) = Trim(res(n, 2) & " " & t(CLng(x), 2))
            'res(n, 3) = Trim(res(n, 3) & " " & t(CLng(x), 1))
            res(n, 2) = res(n, 2) & Chr(10) & t(CLng(x), 2)
            res(n, 3) = res(n, 3) & Chr(10) & t(CLng(x), 1)
         Next x
      Next clef
      
      Application.ScreenUpdating = False
      Intersect(.Range("g3").CurrentRegion, .Rows("3:" & Rows.Count), .Columns("g:i")).Clear
      With .Range("g3").Resize(UBound(res), UBound(res, 2))
         .Value = res
         .Sort key1:=.Range("a1"), order1:=xlAscending, Header:=xlYes
         .Borders.LineStyle = xlContinuous
         .HorizontalAlignment = xlCenter
         .Rows(1).Font.Bold = True
         .Rows(1).Interior.Color = RGB(200, 200, 200)
         .Columns.EntireColumn.AutoFit
      End With
   End With
End Sub

            If Trim(x) <> "" Then
                  dico(x) = Trim(dico(x)) & " " & i
               End If