1 2 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 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68
| Sub Macro_Recherche()
Dim LastLig As Long, DerLig As Long, i As Long
Dim MonDico As Object
Dim myWS As Worksheet
Dim xlWk As Workbook
Dim j As Integer
Dim TbRech, Tb
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
'Remplissage du tableau de recherche
Set xlWk = Workbooks.Open(Chemin_Dossier & Dossier_Sources)
With xlWk.Worksheets(1)
LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
'On met dans la variable tableau TbRech les données de la plage A:G
TbRech = .Range("A2:G" & LastLig)
End With
'on ferme le classeur
xlWk.Close False
Set xlWk = Nothing
'On crée un dictionnaire qui à une clé unique pour chaque article et un item
Set MonDico = CreateObject("Scripting.Dictionary")
'on parcour le tableau TbRech
For i = 1 To UBound(TbRech, 1)
'Si TbRech(i,1) n'existe pas encore comme clé du dico, on ajoute la clé (colonne 1) et on lui affecte la colonne G comme item correspondant
If Not MonDico.Exists(TbRech(i, 1)) Then MonDico.Add TbRech(i, 1), TbRech(i, 7)
Next i
'parcour des différentes colonnes
Set myWS = ThisWorkbook.Worksheets("Feuill1-classeur1")
With myWS
'on parcour les colonnes de Feuill1-classeur1
For j = 11 To 81 Step 5
DerLig = .Cells(.Rows.Count, j).End(xlUp).Row
'on remplit dans Tb pour chaque colonne j les 2 colonnes j et j+1
Tb = .Range(.Cells(4, j), .Cells(DerLig, j + 1))
'on traite Tb à l'aide de la sous procédure expliqué ci-dessus
RECH MonDico, Tb
'on récrit le nouveau tableau Tb dans la plage
.Range(.Cells(4, j), .Cells(DerLig, j + 1)) = Tb
Next j
End With
Set MonDico = Nothing
Set myWS = Nothing
MsgBox "Triatement terminé!"
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub
'Sous procédure qui permet de verifier l'existence de chaque élément
'd'un tableau Res dans les clés du dictionnaire Dic, si oui remplir la 2nd colonne de Res
'par l'item correspondant à la clé trouvée
'Res est déclaré ByRef => informe toi sur la différence entre byval et byref
Private Sub RECH(ByVal Dic As Object, ByRef Res)
Dim i As Long
For i = 1 To UBound(Res, 1)
If Dic.Exists(Res(i, 1)) Then Res(i, 2) = Dic(Res(i, 1))
Next i
End Sub |
Partager