Déchiffrage de macro
Bonjour,
Je suis actuellement en entreprise pour ma formation en licence pro. J'ai eu pour mission de déchiffrer le code ci dessous. J'ai récupérer ses fichiers car personnes ne sait comment faire... Le problème étant que moi non plus
Merci par avance
Sub MAJprepasiepr()
'
'
'ChDrive Left(ActiveWorkbook.FullName, 2)
'ChDir "/"
'ChDir Left(ActiveWorkbook.FullName, Len(ActiveWorkbook.FullName) - 35)
'Application.ScreenUpdating = False
'oldStatusBar = Application.DisplayStatusBar
'Application.DisplayStatusBar = True
'Application.StatusBar = "Mise à jour pluriannuel SIEPR"
Fichierprincipal = "prépaSIEPR.xlsm"
Windows(Fichierprincipal).Activate
'fichiersourcemappingsiepr = Cells(13, 4).Value
'Déterminer l'emplacement du fichier mapping
fichiersourcemappingsiepr = "D:\Documents and Settings\patrietho\Bureau\Outil PrépaSIEPR\export mapping OPI1 special prepaSIEPR.xlsx"
annee1 = Cells(3, 4).Value
Workbooks.Open Filename:=fichiersourcemappingsiepr
fichiersourcemappingsiepr = "export mapping OPI1 special prepaSIEPR.xlsx"
'Activation du fichier mapping
Windows(fichiersourcemappingsiepr).Activate
'Remplacement de "POSTE - " par rien
Columns("C:C").Select
Selection.Replace What:="POSTE - ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells(1, 1).Select
Dim realiseetengage(3, 12) 'car ligne 0 et colonne 0 existent
'Activation du fichier principal
Windows(Fichierprincipal).Activate
nligneprepa = 5
'Faire jusqu'au mot "FIN" colonne 2
Do Until Cells(nligneprepa, 2).Value = "FIN"
libelle = Cells(nligneprepa, 1).Value
intitule = Cells(nligneprepa, 2).Value
lignedecoutprepa = Cells(nligneprepa, 48).Value
nlignerealiseetengage = 1
ncolonnerealiseetengage = 1
Do Until nlignerealiseetengage = 3
Do Until ncolonnerealiseetengage = 12
realiseetengage(nlignerealiseetengage, ncolonnerealiseetengage) = 0
ncolonnerealiseetengage = ncolonnerealiseetengage + 1
Loop
nlignerealiseetengage = nlignerealiseetengage + 1
Loop
' Empecher le rafraîchissement
Application.ScreenUpdating = False
' Verouillage de cellule
'traitement des commandes existantes du fichier prepasiepr
If libelle <> "" Then
Windows(fichiersourcemappingsiepr).Activate
nlignemapping = 3
Do Until Cells(nlignemapping, 3) = ""
lignedecoutmapping = Cells(nlignemapping, 3)
libellemapping = Cells(nlignemapping, 4)
quantite = Cells(nlignemapping, 5)
typedepense = Cells(nlignemapping, 6).Value
datedebut = Cells(nlignemapping, 7).Value
anneedebut = Year(datedebut)
If libellemapping = libelle And lignedecoutmapping = lignedecoutprepa Then
nlignerealiseetengage = 0
If typedepense = "Réalisé GCP" Then
nlignerealiseetengage = 1
ElseIf typedepense = "Engagement GCP" Then
nlignerealiseetengage = 2
End If
ncolonnerealiseetengage = 0
If anneedebut <= annee1 Then
ncolonnerealiseetengage = 1
ElseIf anneedebut >= annee1 + 10 Then
ncolonnerealiseetengage = 11
Else:
ncolonnerealiseetengage = anneedebut - annee1 + 1
End If
realiseetengage(nlignerealiseetengage, ncolonnerealiseetengage) = realiseetengage(nlignerealiseetengage, ncolonnerealiseetengage) + quantite
Rows(nlignemapping).Select
Selection.Delete Shift:=xlUp
nlignemapping = nlignemapping - 1
End If
nlignemapping = nlignemapping + 1
Loop
Windows(Fichierprincipal).Activate
ntab = 1
Do Until ntab = 12
Cells(nligneprepa, 6 + (ntab - 1) * 4) = realiseetengage(1, ntab)
Cells(nligneprepa, 7 + (ntab - 1) * 4) = realiseetengage(2, ntab)
ntab = ntab + 1
Loop
'traitement des réalisés pointage technique et frais de fonctionnement
ElseIf lignedecoutprepa = "Ingénierie " Or lignedecoutprepa = "Ingénierie GESCC" Or lignedecoutprepa = "Prestations GE et GESCC" Or lignedecoutprepa = "Direction de Projet" Or lignedecoutprepa =
"Frais de Fonctionnement" Then
Windows(fichiersourcemappingsiepr).Activate
nlignemapping = 3
Do Until Cells(nlignemapping, 3) = ""
lignedecoutmapping = Cells(nlignemapping, 3)
libellemapping = Cells(nlignemapping, 4)
quantite = Cells(nlignemapping, 5).Value
typedepense = Cells(nlignemapping, 6).Value
datedebut = Cells(nlignemapping, 7).Value
anneedebut = Year(datedebut)
If lignedecoutmapping = lignedecoutprepa Then
nlignerealiseetengage = 0
If typedepense = "Réalisé GCP" Then
nlignerealiseetengage = 1
ElseIf typedepense = "Engagement GCP" Then
nlignerealiseetengage = 2
End If
ncolonnerealiseetengage = 0
If anneedebut <= annee1 Then
ncolonnerealiseetengage = 1
ElseIf anneedebut >= annee1 + 10 Then
ncolonnerealiseetengage = 11
Else:
ncolonnerealiseetengage = anneedebut - annee1 + 1
End If
realiseetengage(nlignerealiseetengage, ncolonnerealiseetengage) = realiseetengage(nlignerealiseetengage, ncolonnerealiseetengage) + quantite
Rows(nlignemapping).Select
Selection.Delete Shift:=xlUp
nlignemapping = nlignemapping - 1
End If
nlignemapping = nlignemapping + 1
Loop
Windows(Fichierprincipal).Activate
ntab = 1
Do Until ntab = 12
Cells(nligneprepa, 6 + (ntab - 1) * 4) = realiseetengage(1, ntab)
Cells(nligneprepa, 7 + (ntab - 1) * 4) = realiseetengage(2, ntab)
ntab = ntab + 1
Loop
End If
nligneprepa = nligneprepa + 1
Loop
'ajout dans prepasiepr des nouvelles commandes du mapping
Windows(fichiersourcemappingsiepr).Activate
Do Until Cells(3, 3) = ""
nlignerealiseetengage = 1
ncolonnerealiseetengage = 1
Do Until nlignerealiseetengage = 3
Do Until ncolonnerealiseetengage = 12
realiseetengage(nlignerealiseetengage, ncolonnerealiseetengage) = 0
ncolonnerealiseetengage = ncolonnerealiseetengage + 1
Loop
nlignerealiseetengage = nlignerealiseetengage + 1
Loop
lignedecoutcommande = Cells(3, 3).Value
libellecommande = Cells(3, 4).Value
nlignemapping = 3
Do Until Cells(nlignemapping, 3) = ""
lignedecoutmapping = Cells(nlignemapping, 3).Value
libellemapping = Cells(nlignemapping, 4).Value
quantite = Cells(nlignemapping, 5).Value
typedepense = Cells(nlignemapping, 6).Value
datedebut = Cells(nlignemapping, 7).Value
anneedebut = Year(datedebut)
If lignedecoutmapping = lignedecoutcommande And libellemapping = libellecommande Then
nlignerealiseetengage = 0
If typedepense = "Réalisé GCP" Then
nlignerealiseetengage = 1
ElseIf typedepense = "Engagement GCP" Then
nlignerealiseetengage = 2
End If
ncolonnerealiseetengage = 0
If anneedebut <= annee1 Then
ncolonnerealiseetengage = 1
ElseIf anneedebut >= annee1 + 10 Then
ncolonnerealiseetengage = 11
Else:
ncolonnerealiseetengage = anneedebut - annee1 + 1
End If
realiseetengage(nlignerealiseetengage, ncolonnerealiseetengage) = realiseetengage(nlignerealiseetengage, ncolonnerealiseetengage) + quantite
Rows(nlignemapping).Select
Selection.Delete Shift:=xlUp
nlignemapping = nlignemapping - 1
End If
nlignemapping = nlignemapping + 1
Loop
Windows(Fichierprincipal).Activate
nligneprepa = 5
test1 = Cells(nligneprepa, 48)
test2 = Cells(nligneprepa + 1, 48)
Do Until test1 = lignedecoutcommande And test2 = ""
nligneprepa = nligneprepa + 1
test1 = Cells(nligneprepa, 48)
test2 = Cells(nligneprepa + 1, 48)
Loop
Rows(nligneprepa).Select
Selection.Copy
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
Cells(nligneprepa, 1) = libellecommande
ntab = 1
Do Until ntab = 12
Cells(nligneprepa, 6 + (ntab - 1) * 4) = realiseetengage(1, ntab)
Cells(nligneprepa, 7 + (ntab - 1) * 4) = realiseetengage(2, ntab)
ntab = ntab + 1
Loop
Windows(fichiersourcemappingsiepr).Activate
Loop
Windows(fichiersourcemappingsiepr).Activate
ActiveWindow.Close SaveChanges:=False
Windows(Fichierprincipal).Activate
'effacement des commandes à montant toal nul dans prepasiepr
'nligne = 3
'Do Until Cells(nligne, 3).Value = ""
' lignedecout = Cells(nligne, 3).Value
' nligne = nligne + 1
'Loop
End SubBonsoir,
"Empecher le rafraîchissement" signifie qu'on empêche Excel d'afficher les lignes intermédiaires du traitement.
c'est cette ligne qui masque les opérations intermédiares :
Application.ScreenUpdating = FalseSi tu mets cette ligne en commentaire cela permet d'observer en pas à pas l'exécution de la macro. Ce qui n'offre aucun intéret si ce n'est celui de ralentir considérablement le déroulement de la macro et de procurer un effet de sautillemnt ou de défilement assez désagréable à l'écran pendant l'exécution.
Pour le reste, personnellement je dirais que c'est un code assez transparent, mais un peu flou.
J'appelle ça du VBA de bac à sable... Le code n'est pas ou peu optimisé. et comme les variables ne sont pas déclarées et avec des noms à rallonge l'ensemble est assez confus surtout quand on n'a pas les classeurs sous les yeux...
En gros le code consiste à passer des données d'une fenêtre à l'autre en passant par un "nuage"
Les fenêtres sont des classeurs mais on ne sait pas de quelle feuille il est question et le "nuage" est un Array (sorte de tableau virtuel) utilisé pour stocker et manipuler des données.
Cet Array c'est "realiseetengage" (un tableau de 4 lignes et 13 colonnes)
On stocke les données de "Fichierprincipal" et de "fichiersourcemappingsiepr" dans l'Array, on manipule, on brasse, on ajoute et on supprime des lignes un peu partout pour obtenir le résultat voulu.
Pour plus de détail sur le pourquoi de chacune des lignes, fournir les fichiers en question...
A+
Merci beaucoup pour votre aide ! Je confirme l'envoi des fichiers sur votre boite mail.
Bonjour,
Finalement je suis retombé sur mes pieds plus rapidement que prévu
J'ai réécrit tout la macro. Je pense que cette réécriture te permettra de mieux comprendre l'algo de calcul.
Le début à été allégé et toute la macro se passe désormais sur la feuille de mapping qui est toujours la FeuilleActive
Quand il est nécessaire de boucler sur la feuille prépa cela est fait par adressage direct avec le "préfixe d'objet" WsP sans qu'il soit nécessaire de passer alternativement d'une Windows à l'autre...
Au lieu de noms de variables longs et peu compréhensibles j'ai travaillé avec des noms de variables courts et explicites.
Ainsi WsP est la WorksheetPrépa ou Principale qui fait elle même partie du WorkbookPrincipal : WbP
Tandis que le classeur "Mapping" s'appelle WbM
Logiquement toutes les variables iRP et iCP appartiennent à WsP et indiquent Lignes et Colonnes iRP = varRow; iCP = varColumn
de même les variables Lignes et Colonnes de "Mapping" s'appellent iRM et iCM
Toutes les autres variables respectent ce principe intitP, libelP font référence à WsP tandis que intitM, libelM se rapportent à "Mapping" ainsi que par exception (vers la fin) intitC, libelC
Le Tablo() virtuel (qui remplace realiseetengage) utilise les mêmes notations de variables iRTo et iCTo pour les variables de Row et de Column et également k utilisé vers la fin pour le transfert du tablo vers WsP.
Je pense que ainsi modifiée la macro sera beaucoup plus lisible pour toi les conditions et comparaisons me semblent beaucoup plus intuitives.
Sub MAJprepasiepr()
Dim WbP As Workbook, WsP As Worksheet, WbM As Workbook
Dim MyWay$, MyFile$, libelP$, intitP$, libelM$, intitM$, libelC$, intitC$
Dim Tablo(3, 12) '4 ligne et 13 colonnes
Dim iRTo%, iCTo%, k% 'variable pour le parcours du Tablo (iR= Row, iC = Column)
Dim iRM%, iRP% 'iRM et iRP sont des variables de lignes pour parcourir WsP et Mapping
'Empecher l'affichage fait gagner du temps de traitement
Application.ScreenUpdating = False
Set WbP = ThisWorkbook
'On travaille sur la feuille1
Set WsP = WbP.Worksheets(1) 'Feuille Cible de prépaSIEPR
annee1 = WsP.Cells(3, 4).Value
'Déterminer l'emplacement du fichier mapping
MyWay = "D:\Documents and Settings\patrietho\Bureau\Outil PrépaSIEPR\"
MyFile = "export mapping OPI1 special prepaSIEPR.xlsx"
'on ouvre le fichier en lecture seule
Workbooks.Open Filename:=MyWay & MyFile, ReadOnly:=True
'On travaille sur des instances
Set WbM = ActiveWorkbook 'mapping
'On travaille dorénavant à partir de WbM
'Remplacement de "POSTE - " par rien
Columns("C:C").Replace What:="POSTE - ", Replacement:="", LookAt:=xlPart
'boucler sur toutes les lignes à partir de la ligne 5 de WsP
iRP = 5
Do Until WsP.Cells(iRP, 2).Value = "FIN"
libelP = WsP.Cells(iRP, 1).Value
intitP = WsP.Cells(iRP, 48).Value
'Initialisation du Tablo
iRTo = 1
iCTo = 1
Do Until iRTo = 3
Do Until iCTo = 12
Tablo(iRTo, iCTo) = 0
iCTo = iCTo + 1
Loop
iRTo = iRTo + 1
Loop
'traitement des commandes existantes de WsP
If libelP <> "" Then
iRM = 3
Do Until Cells(iRM, 3) = ""
intitM = Cells(iRM, 3)
libelM = Cells(iRM, 4)
quantite = Cells(iRM, 5)
typedepense = Cells(iRM, 6).Value
datedebut = Cells(iRM, 7).Value
anneedebut = Year(datedebut)
If libelM = libelP And intitM = intitP Then
iRTo = 0
If typedepense = "Réalisé GCP" Then
iRTo = 1
ElseIf typedepense = "Engagement GCP" Then
iRTo = 2
End If
iCTo = 0
If anneedebut <= annee1 Then
iCTo = 1
ElseIf anneedebut >= annee1 + 10 Then
iCTo = 11
Else
iCTo = anneedebut - annee1 + 1
End If
Tablo(iRTo, iCTo) = Tablo(iRTo, iCTo) + quantite
Rows(iRM).Delete Shift:=xlUp
iRM = iRM - 1
End If
iRM = iRM + 1
Loop
'Transfert du tablo vers WsP
For k = 1 To 11
WsP.Cells(iRP, 6 + (k - 1) * 4) = Tablo(1, k)
WsP.Cells(iRP, 7 + (k - 1) * 4) = Tablo(2, k)
Next
'traitement des réalisés pointage technique et frais de fonctionnement de WSP
ElseIf intitP = "Ingénierie RTE GIMR" Or _
intitP = "Ingénierie GESCC" Or _
intitP = "Prestations GET et GESCC" Or _
intitP = "Direction de Projet" Or _
intitP = "Frais de Fonctionnement" Then
iRM = 3
Do Until Cells(iRM, 3) = ""
intitM = Cells(iRM, 3)
libelM = Cells(iRM, 4)
quantite = Cells(iRM, 5).Value
typedepense = Cells(iRM, 6).Value
datedebut = Cells(iRM, 7).Value
anneedebut = Year(datedebut)
If intitM = intitP Then
iRTo = 0
If typedepense = "Réalisé GCP" Then
iRTo = 1
ElseIf typedepense = "Engagement GCP" Then
iRTo = 2
End If
iCTo = 0
If anneedebut <= annee1 Then
iCTo = 1
ElseIf anneedebut >= annee1 + 10 Then
iCTo = 11
Else
iCTo = anneedebut - annee1 + 1
End If
Tablo(iRTo, iCTo) = Tablo(iRTo, iCTo) + quantite
Rows(iRM).Delete Shift:=xlUp
iRM = iRM - 1
End If
iRM = iRM + 1
Loop
'Transfert du tablo vers WsP
For k = 1 To 11
WsP.Cells(iRP, 6 + (k - 1) * 4) = Tablo(1, k)
WsP.Cells(iRP, 7 + (k - 1) * 4) = Tablo(2, k)
Next
End If
iRP = iRP + 1
Loop
'Fin du bouclage sur WsP
'ajout dans prepasiepr des nouvelles commandes du mapping
Do Until Cells(3, 3) = ""
'Initialisation du Tablo
iRTo = 1
iCTo = 1
Do Until iRTo = 3
Do Until iCTo = 12
Tablo(iRTo, iCTo) = 0
iCTo = iCTo + 1
Loop
iRTo = iRTo + 1
Loop
intitC = Cells(3, 3).Value
libelC = Cells(3, 4).Value
iRM = 3
Do Until Cells(iRM, 3) = ""
intitM = Cells(iRM, 3).Value
libelM = Cells(iRM, 4).Value
quantite = Cells(iRM, 5).Value
typedepense = Cells(iRM, 6).Value
datedebut = Cells(iRM, 7).Value
anneedebut = Year(datedebut)
If intitM = intitC And libelM = libelC Then
iRTo = 0
If typedepense = "Réalisé GCP" Then
iRTo = 1
ElseIf typedepense = "Engagement GCP" Then
iRTo = 2
End If
iCTo = 0
If anneedebut <= annee1 Then
iCTo = 1
ElseIf anneedebut >= annee1 + 10 Then
iCTo = 11
Else
iCTo = anneedebut - annee1 + 1
End If
Tablo(iRTo, iCTo) = Tablo(iRTo, iCTo) + quantite
Rows(iRM).Delete Shift:=xlUp
iRM = iRM - 1
End If
iRM = iRM + 1
Loop
'préparation de WsP
iRP = 5
test1 = WsP.Cells(iRP, 48)
test2 = WsP.Cells(iRP + 1, 48)
Do Until test1 = intitC And test2 = ""
iRP = iRP + 1
test1 = WsP.Cells(iRP, 48)
test2 = WsP.Cells(iRP + 1, 48)
Loop
WsP.Rows(iRP).Copy
WsP.Rows(iRP).Insert Shift:=xlDown
'Application.CutCopyMode = False
WsP.Cells(iRP, 1) = libelC
'Transfert du tablo vers WsP
For k = 1 To 11
WsP.Cells(iRP, 6 + (k - 1) * 4) = Tablo(1, k)
WsP.Cells(iRP, 7 + (k - 1) * 4) = Tablo(2, k)
Next
Loop
WbM.Close SaveChanges:=False
End SubA+
Un très très gros merci a galopin01 pour la rapidité et pour un travail aussi propre !
Je crois que c’était impossible de faire mieux !
Merci beaucoup !