Remplir un tableau à partir d'un autre sous conditions
m
Bonjour tout le monde!
Je suis débutante en Excel VBA et j'ai besoin de votre aide SVP
Je souhaite automatiser le transfert de données d'un tableau vers un autre sous des conditions/critères.
Dans le fichier ci-joint vous trouverez deux onglets.
Dans l'onglet "tableau" j'ai mon tableau qui contient les données à transférer et dans l'onglet "matrice" le tableau à remplier automatiquement (sur le fichier je l'ai remplie à la main).
Je vous remercie par avance
Bonsoir mariaCLARA,
Vois ceci :
Option Explicit
Sub ventile()
Dim a, i As Long, j As Long, dico As Object
Set dico = CreateObject("Scripting.Dictionary")
dico.CompareMode = 1
a = Sheets("tableau").[a1].CurrentRegion.Value
For i = 2 To UBound(a, 1)
If Not dico.exists(a(i, 2)) Then
Set dico(a(i, 2)) = CreateObject("Scripting.Dictionary")
dico(a(i, 2)).CompareMode = 1
End If
dico(a(i, 2))(a(i, 3)) = dico(a(i, 2))(a(i, 3)) & _
IIf(dico(a(i, 2))(a(i, 3)) <> "", "; ", "") & a(i, 1)
Next
Application.ScreenUpdating = False
With Sheets("matrice").[a1:g6]
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(.Cells(i, 1).Value)(.Cells(1, j).Value)
End If
Next
End If
Next
End With
Set dico = Nothing
Application.ScreenUpdating = True
End Sub
klin89