Bonjour,

Je dois parcourir une plage de cellules d'un fichier à la recherche d'une cellule équivalente dans un second fichier afin de retourner le résultat d'une autre cellule. C'est un genre de RECHERCHEV et RECHERCHEH mais en VBA.

Voici mon code :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
Sub LossTree()
    Dim chemin, fichier, onglet, chemin2, fichier2, onglet2 As String
    Dim colonne, ligne, ligne_debut, ligne_fin, colonne2, colonne2_debut, colonne2_fin, ligne2 As Integer
 
    'On désactive l'affichage et le calcul
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    'Initialisation des variables
    ligne_debut = 26
    ligne_fin = 1064
    colonne = Range("D1").Column
    chemin = "mon chemin"
    fichier = "mon fichier"
    onglet = "mon onglet"
    '--------------------------------------------------
    colonne2_debut = Range("BT1").Column
    colonne2_fin = Range("FF1").Column
    ligne2 = 10
    chemin2 = "mon chemin"
    fichier2 = "mon fichier"
    onglet2 = "mon onglet"
 
    'Ouverture du fichier
    Workbooks.Open (chemin2 & fichier2)
 
    'On se positionne sur le bon onglet du second fichier
    'Workbooks(fichier2).Worksheets(onglet2).Activate
 
    'On se positionne sur le bon onglet du premier fichier
    'Workbooks(fichier).Worksheets(onglet).Activate
 
    'On parcourt les lignes de la plage de cellules
    For ligne = ligne_debut To ligne_fin Step 2
        'On vérifie si la cellule est non vide
        If Workbooks(fichier).Worksheets(onglet).Cells(ligne, colonne).Value <> "" Then
            'On recherche la correspondance dans l'autre fichier
            For colonne2 = colonne2_debut To colonne2_fin
                If Workbooks(fichier).Worksheets(onglet).Cells(ligne, colonne).Value = Workbooks(fichier2).Worksheets(onglet2).Cells(ligne2, colonne2).Value Then
                    Workbooks(fichier).Worksheets(onglet).Cells(ligne, Range("CR1").Column).Value = Workbooks(fichier2).Worksheets(onglet2).Cells(110, colonne2).Value
                End If
            Next colonne2
        End If
    Next ligne
 
    'Fermeture du fichier
    Workbooks(fichier2).Close
 
    'On active l'affichage et le calcul
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub
Mon code vous semble-t-il optimisé, quel avis avez-vous dessus ?

Merci,
ZiP