| 12
 3
 4
 5
 6
 7
 8
 9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 
 | Option Explicit
 
'A jouter la référence à microsoft Scripting Runtiome
 
Sub FusionFeuilles()
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim sh3 As Worksheet
Dim mDico As New Dictionary
 
Set sh1 = ThisWorkbook.Sheets("Feuil1")
Set sh2 = ThisWorkbook.Sheets("Feuil2")
Set sh3 = ThisWorkbook.Sheets("Feuil3")
Dim i As Integer
 
'Lecture feuille
i = 2 'Ligne 1 = Titre
While sh1.Cells(i, 1) <> ""
  If Not mDico.Exists(sh1.Cells(i, 1).Text) Then
    'Cas ou n'existe pas créé l'enregistrement
    mDico.Add sh1.Cells(i, 1).Text, sh1.Cells(i, 2).text
   Else
    'Cas ou existe déjà Incrémente
    mDico(sh1.Cells(i, 1).Text) = mDico(sh1.Cells(i, 1).Text) + sh1.Cells(i, 2).Text
  End If
 i = i + 1 'Ligne suivante
Wend
i = 2 'Ligne 1 = Titre
While sh2.Cells(i, 1) <> ""
  If Not mDico.Exists(sh2.Cells(i, 1).Text) Then
    'Cas ou n'existe pas créé l'enregistrement
    mDico.Add sh2.Cells(i, 1).Text, sh2.Cells(i, 2)
   Else
    'Cas ou existe déjà Incrémente
    mDico(sh2.Cells(i, 1).Text) = mDico(sh2.Cells(i, 1).Text) + sh2.Cells(i, 2).Text
  End If
 i = i + 1 'Ligne suivante
Wend
 
 
 sh3.Cells(1, 1) = sh1.Cells(1, 1) 'Copy entête
 sh3.Cells(1, 2) = sh1.Cells(1, 2)
 For i = 0 To mDico.Count - 1
    sh3.Cells(i + 2, 1) = mDico.Keys(i) 'Récupére Nom
    sh3.Cells(i + 2, 2) = mDico.Items(i) 'Récupére nombre
 
 
 Next
 
 End Sub | 
Partager