Besoin d'une macro plus "professionnelle"

[ELSONCe]

Bonjour à tous,

Avec un collègue, nous avons réalisé la macro que vous trouverez ci-dessous, qui fonctionne merveilleusement bien. Cependant, nous savons tous les deux que c'est du "bricolage" . C'est pourquoi je fais appel aux "Grands Excelliens" pour m'aider à allèger et simplifier cette macro... Pour info, le but est de venir copier les informations d'un tableau(1) qui se trouve sur 13 postes différents sous T: pour les coller et les enregistrer sans doublons dans un tableau(2) de sauvegarde toujours sous T:.

Voici notre fameux bricolage :

Sub macro1()
Application.StatusBar = "Collecte des données correspondants en cours..."
Dim cpt As Integer
Dim dec As Integer
Dim gen As Integer
Dim corres As Integer
Dim a, b, c, d, e, f, g, h, i, j, k As String
Dim a1, b1, c1, d1, e1, f1, g1, h1, i1, j1, k1 As String
Dim ar, br, cr, dr, er, fr, gr, hr, ir, jr, kr As Integer
Dim ResultF As Integer
Dim cpt2 As Integer

cpt = 0
dec = 0
corres = 0
ar = 0
br = 0
cr = 0
dr = 0
er = 0
fr = 0
gr = 0
hr = 0
ir = 0

debut:
dec = 0
cpt = 3
gen = 3
corres = corres + 1

If corres = 14 Then GoTo finprogramme

ChDir "T:\REFABRICATION SAV"
Workbooks.Open Filename:= _
"T:\REFABRICATION SAV\CORRESPONDANTS\Correspondant" & Str(corres) & ".xlsm"


Windows("Correspondant" & Str(corres) & ".xlsm").Activate
cpt = 3
compteur1:
cpt = cpt + 1
If Range("B" & cpt).Value = "" Then GoTo fin:
dec = dec + 1
GoTo compteur1

fin:
If dec = 0 Then GoTo debut:
Sheets("SUIVI SAV").Range("A4", "K" & cpt - 1).Copy
ActiveWorkbook.Close SaveChanges:=True
Windows("SUIVI GLOBAL SAV.xlsm").Activate

gen = 3
general:
gen = gen + 1
If Range("B" & gen).Value = "" Then GoTo fingeneral:
GoTo general

fingeneral:
Range("A" & gen).Select
ActiveSheet.Paste
cpt = 3
gen = 3
GoTo debut

finprogramme:
cpt = 3
boucletri:
cpt = cpt + 1
If Range("B" & cpt).Value = "" Then GoTo debtri:
GoTo boucletri:
debtri:
Range("A4", "I" & cpt - 1).Select
ActiveWorkbook.Worksheets("SAV").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("SAV").Sort.SortFields.Add Key:=Range("B4", "B" & cpt - 1), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("SAV").Sort.SortFields.Add Key:=Range("C4", "C" & cpt - 1), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("SAV").Sort.SortFields.Add Key:=Range("D4", "D" & cpt - 1), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("SAV").Sort.SortFields.Add Key:=Range("E4", "E" & cpt - 1), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("SAV").Sort.SortFields.Add Key:=Range("G4", "G" & cpt - 1), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("SAV").Sort.SortFields.Add Key:=Range("H4", "H" & cpt - 1), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("SAV").Sort
.SetRange Range("A3", "K" & cpt - 1)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

fintri:
cpt2 = 3
compteurdoublon:
ar = 0
br = 0
cr = 0
dr = 0
er = 0
fr = 0
gr = 0
hr = 0
ir = 0
cpt2 = cpt2 + 1
If Range("B" & cpt2).Value = "" Then GoTo findoublon:
a = Range("A" & cpt2).Value
a1 = Range("A" & cpt2 + 1).Value
b = Range("B" & cpt2).Value
b1 = Range("B" & cpt2 + 1).Value
c = Range("C" & cpt2).Value
c1 = Range("C" & cpt2 + 1).Value
d = Range("D" & cpt2).Value
d1 = Range("D" & cpt2 + 1).Value
If a = a1 Then ar = 1
If b = b1 Then br = 1
If c = c1 Then cr = 1
If d = d1 Then dr = 1

ResultF = ar + br + cr + dr
If ResultF = 4 Then
Rows(cpt2).Select
Selection.Delete Shift:=xlUp
cpt2 = cpt2 - 1
End If
GoTo compteurdoublon

findoublon:

End Sub


Voilà...

Vous remerciant par avance pour vos propositions.


Cordialement Cédric

 

[Jam]

Re : Besoin d'une macro plus "professionnelle"

Bonjour à tous,

Plusieurs petites remarques:
- Utiliser Goto c'est pas bien depuis que le Basic s'est transformé en Visual Basic. Il faut utiliser les boucles ou bien appeler d'autres Procédures/Fonctions => cela revient à découper le programme en sous-procédures qui sont appelées pas les autres procédures en fonctions des besoins (jeter un oeil sur l'aide d'Excel )
- les déclarations de variables telles que celles-ci Dim a, b, c, d, e, f, g, h, i, j, k As String sont incorrectes. En effet, cela revient à ne déclarer que la dernière variable (k ici ) comme String. Toutes les autres sont en Variant. Contrairement au VB, le VBA nécessite la déclaration explicite de chaque variable.
- Dans l'initialisation des variables, pourquoi mettre à 0 dec, cpt, corres et gen pour les "initialiser" à nouveau sous l'étiquette debut ?
- la barre de statut initialisée au début du programme avec Application.StatusBar = "Collecte..." doit être "remise à zéro" à la fin du traitement. Sinon le message va rester afficher longtemps
- Y'a un With...End With qui traine dans le code...Bin, pourquoi ne pas l'appliquer sur les lignes le précédent puisqu'il fait référence au même objet, à savoir ActiveWorkbook.Worksheets("SAV") ?

Voili-voilou pour mes petites suggestions. Je n'ai pas regardé les différents fichiers, car je pense qu'il est plus didactique et plus bénéfique de "réfléchir" à ce qui a été fait que de livrer une solution toute faite.

Bonne journée

 

[Gorfael]

Re : Besoin d'une macro plus "professionnelle"

Salut ELSONCe et le forum
Quelques petits rappels :
- Il n'y a ni devin, ni télépathe sur ce site. Et pas grand monde connaissant l'utilisation de ton classeur. Donc, c'est peut-être évident pour eux, mais pas pour nous.
- Personnellement, les images ne m'intéressent plus depuis Mat Sup (maternelle supérieure ). Au lieu des PDF inexploitables, un bout de fichier d'essai aurait été plus profitable.
- Il serait mieux d'utiliser les balises pour le code (icone# en message avancé) : c'est plus lisible !
- Le Titanic a été construit par des professionnels... L'Arche de Noé par des amateurs !
- Aussi nul que te semble un code que tu ponds, Il t'es propre ! L'améliorer demande de l'aide au début. Mais l'améliorer ne le rendra pas plus "professionnel". Ce qui doit importer, plus que son apparence, ce sont sa logique, sa lisibilité et sa facilité à le maintenir.
- Tu donnes ton code comme fonctionnant correctement => je ne critiquerais pas l'algorithme, juste les instructions, en fonction de ce que j'en pense (je n'ai que la version Excel 2003)

Je ne doublerais pas les remarques de Jam (Salut) qui me semblent pleines de logiques.

corres = corres + 1
If corres = 14 Then GoTo finprogramme

Ce que je lis : c'est une boucle pour des valeurs allant de 1 à 13. Il y a plusieurs méthodes, dont :

for corres=1 to 13
    'le code
Next corres

ChDir "T:\REFABRICATION SAV"

Je ne vois pas à quoi ça sert ici : L'instruction ChDir change le dossier par défaut mais pas le lecteur par défaut. Par exemple, si C est le lecteur par défaut, l'instruction ci-dessous change le dossier par défaut sur le lecteur D, mais C reste le lecteur par défaut (cf aide excel)

Workbooks.Open Filename:= _
        "T:\REFABRICATION SAV\CORRESPONDANTS\Correspondant" & Str(corres) & ".xlsm"
    Windows("Correspondant" & Str(corres) & ".xlsm").Activate

"& Str(corres) &" : sert à rien de convertir un nombre en texte, s'il est associé à du texte "& corres &" suffit
Windows(...).activate => tu viens de l'ouvrir => c'est forcément le classeur actif => la seconde ligne ne sert à rien.
Par contre, tu ne précises pas la feuille du classeur. Ne connaissant pas la structure du classeur et les habitudes des utilisateurs, on ne peut qu'espérer que quand ils sauvent les classeurs, la feuille active est la bonne !

cpt = 3
compteur1:
    cpt = cpt + 1
    If Range("B" & cpt).Value = "" Then GoTo fin:
     dec = dec + 1
    GoTo compteur1

Ce que je lis : trouver la première ligne vide de la colonne B. comme tu l'utilises en "cpt-1", je comprends : trouver la dernière ligne non-vide en B. Ne connaissant pas le fichier, il peut y avoir d'autres données après le premier tableau, et B3 ou B4 peuvent être vides ou non, je ne peux pas savoir s'il est préférable d'utiliser un End(xlDown) ou un End(xlUp). Donc, je m'en tiendrais à mes habitudes :

Dec=cells(rows.count,"B").End(xlUp).row

Dec = première cellule non-vide en partant de la cellule de B située à la ligne "nombre de lignes de la feuille" et en remontant (65536 sur version 2003 et précédentes, un peu plus sur les suivantes).

Sheets("SUIVI SAV").Range("A4", "K" & cpt - 1).Copy
    ActiveWorkbook.Close SaveChanges:=True
    Windows("SUIVI GLOBAL SAV.xlsm").Activate
   fingeneral:
    Range("A" & gen).Select
    ActiveSheet.Paste

Pour la copie, je préfère :

sheets(...).Range(...).Copy WorkBooks(...).sheets(...).range(...)

Je ne comprends pas l'utilité de sauvegarder le fichier source (pas de modif et on perdra la date de la dernière sauvegarde).

Pour ta boucle de tri, elle me semble "lourde", mais je ne connais ni les capacités, ni le code spécifique à la version 10.
Par contre, tu tries de la colonne H à la colonne B et sur la version 2003, tu pourrais le faire en 2 fois au lieu de 6 : un tri sur H, G, E, puis un tri sur D, C, B.

Pour le traitement des doublons sur A, B, C, D, j'utiliserais plutôt un filtre élaboré, en supprimant toutes les lignes masquées. Mais ça, c'est une autre histoire...
A+

 

[ELSONCe]

Re : Besoin d'une macro plus "professionnelle"

Jam,

Merci pour toutes ces précisions mais c'est presque du chinois pour moi. Quand je dis que nous avons fait du "bricolage" c'est-à-dire que nous nous sommes très largement inspiré de diverses macros que nous avons pu trouver à gauche et à droite. Nous avons eu la chance qu'elle fonctionne finalement cette macro Je sais juste qu'à terme cette merveilleuse macro prendra un temps fou pour réaliser ce qu'elle fait bien actuellement. C'est pourquoi j'aurais souhaité que l'on me dise, comme tu l'as si bien fait, où il y a des incohérences, mais aussi avec une solution partielle ou complète...

Je sais, j'en demande beaucoup, mais cela fait plus d'un mois que je bosse dessus et je ne dors plus la nuit

MERCI dans tous les cas et bonne journée à tous !!!


Cordialement Cédric

 

[ELSONCe]

Re : Besoin d'une macro plus "professionnelle"

Un GRAND MERCI Gorfael pour tes remarques des plus constructives !!! J'essaie et je te dis quoi

Bonne fin de journée !!


Cordialement Cédric