1 pièce(s) jointe(s)
Aide pour finir de coder une macro VBA.
Hello,
Je suis pas un pro du VBA excel mais j'apprend en cherchant sur le net malheureusement je n'ai pas trouvé la solution dans mon cas :
J'ai une boucle qui fonctionne bien pour rajouter une nouvelle ligne de File System si la valeur n’existe pas dans le bilan.
Cela fonctionne aussi bien si une valeur contenant les valeurs concaténées entre l’onglet FS et le bilan sont similaires, alors la macro rajoute les valeurs les plus récentes depuis l’onglet FS (sources des données mensuelles les plus à jour) par rapport à ses données dans les bonnes colonnes du bilan.
Par contre, si une nouvelle donnée dans l’onglet FS est présente et aussi présente dans l’onglet Bilan mais pas sur les mêmes lignes la macro ne parvient plus à faire le lien entre les données, ni la clef de recherche.
De ce fait, la macro va écraser la ligne suivante qui est devenu la ligne courante avec la valeur précédente…
J’espère que vous pourrez m’aider sur ce dernier point, voici l’exemple détaillé représentant le cas qui me pose problème :
Cas en mode débugge en image :
Pièce jointe 405387
Voici le 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
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
| Sub FS_RECUP_BILAN()
FS_RECUP_BILAN Macro
If MsgBox("Souhaitez-vous continuer ?", vbQuestion + vbYesNo, "QUESTION") = vbYes Then
' Code si la réponse est "oui"
'Application.StatusBar = "Patientez S.V.P. Traitement en cours... "
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
' Remise à jour de la colonne X (FS current value) dans la colonne Y (FS previous value) pour le Bilan
Sheets("Bilan FS").Select
Range("X2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.End(xlUp).Select
Range("Y2").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("X2").Select
Range(Selection, Selection.End(xlDown)).Select
' Supprime le contenu de la col X vers la col Y
Selection.ClearContents
Selection.End(xlUp).Select
' ******************************************************************
' Déclaration des variables et commandes de mise à jour du bilan FS
' ******************************************************************
Dim ws_Bilan As Worksheet
Dim ws_FS As Worksheet
Dim l_DerLigFS As Long
Dim l_DerLigBilan As Long
Dim l_LigCouranteFS As Long
Dim l_LigCouranteBilan As Long
Dim r_PlageCle As Range
Dim r_PlageDate As Range
Dim r_CleTrouve As Range
' Initialisation des variables feuilles
Set ws_Bilan = ActiveWorkbook.Sheets("Bilan FS")
Set ws_FS = ActiveWorkbook.Sheets("FS")
' Calcul des dernieres lignes
l_DerLigBilan = ws_Bilan.Range("A" & Rows.Count).End(xlUp).Row
l_DerLigFS = ws_FS.Range("A" & Rows.Count).End(xlUp).Row
' Creation des cle de recherche
For l_LigCouranteBilan = 2 To l_DerLigBilan
ws_Bilan.Range("AA" & l_LigCouranteBilan) = ws_Bilan.Range("A" & l_LigCouranteBilan) & "-" & ws_Bilan.Range("B" & l_LigCouranteBilan)
Next l_LigCouranteBilan
' Initialisation Plage de Recherche Cle sur Col "AA" de Bilan
Set r_PlageCle = ws_Bilan.Range("AA:AA")
' Initialisation Plage de Recherche Date sur Ligne C1:N1 de Bilan
Set r_PlageDate = ws_Bilan.Range("C1:N1")
' Appel de la barre de progression du Bilan FS
Frm_ProgressBar.Show 0 ' Mode non modal
Frm_ProgressBar.Caption = Mid$(Frm_ProgressBar.Caption, 1, 13) & ": " & s_TitreMsg
Frm_ProgressBar.Label_barre2.Caption = l_DerLigFS & " lignes à traiter"
Frm_ProgressBar.Height = 70
' Boucle sur FS
For l_LigCouranteFS = 2 To l_DerLigFS
' MAJ de la barre de progresssion du Bilan FS
ws_Bilan.Activate ' Choix du la feuille a afficher
Frm_ProgressBar.Show 0
Call Frm_ProgressBar.MAJBarre(l_LigCouranteFS, l_DerLigFS)
Frm_ProgressBar.Repaint
' Recherche de la Cle (FS colonne G) dans colonne AA de Bilan
Set r_CleTrouve = r_PlageCle.Find(ws_FS.Range("G" & l_LigCouranteFS), lookat:=xlPart, LookIn:=xlValues)
' Recherche de la date (FS colonne F) dans colonnes C1:N1 de Bilan
Set r_PlageDate = r_PlageDate.Find(ws_FS.Range("F" & l_LigCouranteFS), lookat:=xlPart, LookIn:=xlValues)
If r_PlageDate Is Nothing Then
' Message d'avertissement date MySQL
MsgBox "Attention !! Pas de correspondances de date avec certaines données sources MySQL - Voir feuille (FS Colonne F)"
MsgBox "*** Interruption du traitement des données ***"
Exit For
End If
If Not r_CleTrouve Is Nothing Then
' MAJ valeurs (FS colonne D) dans la colonne Date trouvee de Bilan
r_PlageDate(l_LigCouranteFS) = ws_FS.Range("D" & l_LigCouranteFS)
' MAJ valeurs colonne X de la valeur trouvée (FS colonne E)
ws_Bilan.Range("X" & l_LigCouranteFS) = ws_FS.Range("E" & r_CleTrouve.Row)
' Incremente derniere ligne Bilan (FS colonne E)
End If
If r_CleTrouve Is Nothing Then
' MAJ valeurs colonne A de la valeur trouvée (FS colonne A)
ws_Bilan.Range("A" & l_DerLigBilan + 1) = ws_FS.Range("A" & l_LigCouranteFS)
' MAJ valeurs colonne B de la valeur trouvée (FS colonne B)
ws_Bilan.Range("B" & l_DerLigBilan + 1) = ws_FS.Range("B" & l_LigCouranteFS)
' MAJ valeurs (FS colonne D) dans la colonne Date trouvee de Bilan
r_PlageDate(l_DerLigBilan + 1) = ws_FS.Range("D" & l_LigCouranteFS)
' MAJ valeurs colonne X de la valeur trouvée (FS colonne E)
ws_Bilan.Range("X" & l_DerLigBilan + 1) = ws_FS.Range("E" & l_LigCouranteFS)
' Incremente derniere ligne Bilan (FS colonne E)
l_DerLigBilan = l_DerLigBilan + 1
End If
Next l_LigCouranteFS
' On efface la colonne de la cle de recherche dans Bilan Colonne AA
ws_Bilan.Range("AA:AA").ClearContents
Application.Calculation = xlCalculationAutomatic
'Application.StatusBar = False
Application.ScreenUpdating = True
' On agrandit la fenetre de la barre de progression
Frm_ProgressBar.Height = 110
Else
' Code si la réponse est "non"
MsgBox "Opération annulée"
End If
End Sub |
Merci d’avance…
