Votre avis sur mon code en VBA ?
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:
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
