Option Explicit
Sub test()
Dim i As Long, j As Long, e, dico As Object
Set dico = CreateObject("Scripting.Dictionary")
dico.CompareMode = 1
With Sheets("2014").Range("a1").CurrentRegion
For i = 2 To .Rows.Count
Set dico(.Cells(i, 1).Value) = CreateObject("Scripting.Dictionary")
dico(.Cells(i, 1).Value).CompareMode = 1
For j = 2 To .Columns.Count
If .Cells(i, j).Value <> "" Then
dico(.Cells(i, 1).Value)(.Cells(1, j).Value) = .Cells(i, j).Value
End If
Next
Next
End With
Application.ScreenUpdating = False
For Each e In Array("2015", "2016", "2017")
With Sheets(e)
With .Range("a1").CurrentRegion
With .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1)
.ClearContents
End With
For i = 2 To .Rows.Count
If dico.exists(.Cells(i, 1).Value) Then
For j = 2 To .Columns.Count
If dico(.Cells(i, 1).Value).exists(.Cells(1, j).Value) Then
.Cells(i, j).Value = dico.Item(.Cells(i, 1).Value)(.Cells(1, j).Value)
End If
Next
End If
Next
End With
End With
Next
Set dico = Nothing
Application.ScreenUpdating = True
End Sub
Option Explicit
Sub test()
Dim a, i As Long, j As Long, e, dico As Object
Set dico = CreateObject("Scripting.Dictionary")
dico.Comparemode = 1
With Sheets("2014").Range("a1").CurrentRegion
a = .Value
For i = 2 To UBound(a, 1)
Set dico(a(i, 1)) = CreateObject("Scripting.Dictionary")
dico(a(i, 1)).Comparemode = 1
For j = 2 To UBound(a, 2)
dico(a(i, 1))(a(1, j)) = a(i, j)
Next
Next
End With
Application.ScreenUpdating = False
For Each e In Array("2015", "2016", "2017")
With Sheets(e)
With .Range("a1").CurrentRegion
With .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1)
.ClearContents
End With
For i = 2 To .Rows.Count
If dico.exists(.Cells(i, 1).Value) Then
.Cells(i, 2).Resize(, dico(.Cells(i, 1).Value).Count).Value = _
dico(.Cells(i, 1).Value).items
End If
Next
End With
End With
Next
Set dico = Nothing
Application.ScreenUpdating = True
End Sub
Set dico(.Cells(i, 1).Value) = CreateObject("Scripting.Dictionary")
dico(.Cells(i, 1).Value).CompareMode = 1
Option Explicit
Sub test()
Dim a, i As Long, j As Long, e, dico As Object
Set dico = CreateObject("Scripting.Dictionary")
dico.CompareMode = 1
With Sheets("2014").Range("a1").CurrentRegion
a = .Value
For i = 2 To UBound(a, 1)
'l'item associé à la clé est un tableau à 1 dimension, l'indice commençant à 0
'on utilise la fonction array pour fixer les 8 éléments retenus (0 à 7)
'pour ajouter la clé et associer son élément,
'on emploie la propriété Item du dictionnaire
dico.Item(a(i, 1)) = Array(a(i, 2), a(i, 3), a(i, 4), a(i, 5), _
a(i, 6), a(i, 7), a(i, 8), a(i, 9))
Next
End With
Application.ScreenUpdating = False
For Each e In Array("2015", "2016", "2017")
With Sheets(e)
With .Range("a1").CurrentRegion
With .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1)
.ClearContents
End With
For i = 2 To .Rows.Count
'si la clé existe
If dico.exists(.Cells(i, 1).Value) Then
.Cells(i, 2).Resize(, UBound(dico.Item(.Cells(i, 1).Value)) + 1).Value = _
dico.Item(.Cells(i, 1).Value)
End If
Next
End With
End With
Next
Set dico = Nothing
Application.ScreenUpdating = True
End Sub
le problème, c'est que le demandeur ne nous dit pas toutSauf erreur de ma part, le code vide les feuilles avant de réinjecter les données.
With .Range("a1").CurrentRegion
With .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1)
.ClearContents
End With