[VBA]Nettoyage de code

waligaroux

waligaroux

XLDnaute Nouveau
Bonjour à tous,

Voici, mon code fonctionne très bien. Il fait tout ce que je demande est rapide. Mais je me demandais s'il y avait moyen de l'améliorer. Je me disais qu'un système de boucle devrait améliorer le code. Mais je n'arrive pas à le mettre en place.

Sub Sauvegarde()Dim maLigne As Long, maLigne2 As Long, NomCherche As String, Result As Range, PlageDeRecherche As Range
Dim WD As Worksheet
Dim WP As Worksheet


Set WD = Worksheets("Devis")
Set WP = Worksheets("Planning")
'**************************************************************************************************
'Vérifie si la date est mentionnée
If WD.Range("date") = "" Then
MsgBox "Veuillez sélectionner la date de l'événement."
WD.Range("date").Select 'Se positionne sur la case Date

'Vérifie si le nom du client est mentionné
ElseIf WD.Range("B5") = "" Then
MsgBox "Veuillez indiquer le nom du client."
WD.Range("B5").Select 'Se positionne sur la case Client
Else
'**************************************************************************************************
'Détermine le numéro du devis à rechercher
NomCherche = Range("n_devis").Value


WP.Activate
Set PlageDeRecherche = WP.Columns(1)

Set Result = PlageDeRecherche.Cells.Find(what:=NomCherche, LookAt:=xlWhole)
If Result Is Nothing Then


maLigne = WP.Range("A" & Rows.Count).End(xlUp).Row + 1

For a = 3 To 7
For b = 5 To 9
Cells(maLigne, a).Value = WD.Cells(b, 2).Value
Next b
Next a

'Coordonnées client
Cells(maLigne, 1) = Range("n_devis").Value
Cells(maLigne, 2) = WD.Range("F12").Value
Cells(maLigne, 3) = WD.Range("B5").Value
Cells(maLigne, 4) = WD.Range("B6").Value
Cells(maLigne, 5) = WD.Range("B7").Value
Cells(maLigne, 6) = WD.Range("B8").Value
Cells(maLigne, 7) = WD.Range("B9").Value
Cells(maLigne, 8) = WD.Range("F5").Value
Cells(maLigne, 9) = WD.Range("F6").Value
Cells(maLigne, 10) = WD.Range("F7").Value
Cells(maLigne, 11) = WD.Range("F8").Value
Cells(maLigne, 12) = WD.Range("F9").Value

'Détail du programme
Cells(maLigne, 13) = WD.Range("G17").Value
Cells(maLigne, 14) = WD.Range("A17").Value
Cells(maLigne, 15) = WD.Range("C17").Value
Cells(maLigne, 16) = WD.Range("D17").Value
Cells(maLigne, 17) = WD.Range("E17").Value
Cells(maLigne, 18) = WD.Range("G18").Value
Cells(maLigne, 19) = WD.Range("A18").Value
Cells(maLigne, 20) = WD.Range("C18").Value
Cells(maLigne, 21) = WD.Range("D18").Value
Cells(maLigne, 22) = WD.Range("E18").Value
Cells(maLigne, 23) = WD.Range("G19").Value
Cells(maLigne, 24) = WD.Range("A19").Value
Cells(maLigne, 25) = WD.Range("C19").Value
Cells(maLigne, 26) = WD.Range("D19").Value
Cells(maLigne, 27) = WD.Range("E19").Value
Cells(maLigne, 28) = WD.Range("G20").Value
Cells(maLigne, 29) = WD.Range("A20").Value
Cells(maLigne, 30) = WD.Range("C20").Value
Cells(maLigne, 31) = WD.Range("D20").Value
Cells(maLigne, 32) = WD.Range("E20").Value
Cells(maLigne, 33) = WD.Range("G21").Value
Cells(maLigne, 34) = WD.Range("A21").Value
Cells(maLigne, 35) = WD.Range("C21").Value
Cells(maLigne, 36) = WD.Range("D21").Value
Cells(maLigne, 37) = WD.Range("E21").Value
Cells(maLigne, 38) = WD.Range("G22").Value
Cells(maLigne, 39) = WD.Range("A22").Value
Cells(maLigne, 40) = WD.Range("C22").Value
Cells(maLigne, 41) = WD.Range("D22").Value
Cells(maLigne, 42) = WD.Range("E22").Value
Cells(maLigne, 43) = WD.Range("G23").Value
Cells(maLigne, 44) = WD.Range("A23").Value
Cells(maLigne, 45) = WD.Range("C23").Value
Cells(maLigne, 46) = WD.Range("D23").Value
Cells(maLigne, 47) = WD.Range("E23").Value
Cells(maLigne, 48) = WD.Range("G24").Value
Cells(maLigne, 49) = WD.Range("A24").Value
Cells(maLigne, 50) = WD.Range("C24").Value
Cells(maLigne, 51) = WD.Range("D24").Value
Cells(maLigne, 52) = WD.Range("E24").Value
Cells(maLigne, 53) = WD.Range("G25").Value
Cells(maLigne, 54) = WD.Range("A25").Value
Cells(maLigne, 55) = WD.Range("C25").Value
Cells(maLigne, 56) = WD.Range("D25").Value
Cells(maLigne, 57) = WD.Range("E25").Value
Cells(maLigne, 58) = WD.Range("G26").Value
Cells(maLigne, 59) = WD.Range("A26").Value
Cells(maLigne, 60) = WD.Range("C26").Value
Cells(maLigne, 61) = WD.Range("D26").Value
Cells(maLigne, 62) = WD.Range("E26").Value

'Descriptif
Cells(maLigne, 63) = WD.Range("A31").Value

'Détails des coûts
Cells(maLigne, 64) = WD.Range("A45").Value
Cells(maLigne, 65) = WD.Range("C45").Value
Cells(maLigne, 66) = WD.Range("D45").Value
Cells(maLigne, 67) = WD.Range("A46").Value
Cells(maLigne, 68) = WD.Range("C46").Value
Cells(maLigne, 69) = WD.Range("D46").Value
Cells(maLigne, 70) = WD.Range("A47").Value
Cells(maLigne, 71) = WD.Range("C47").Value
Cells(maLigne, 72) = WD.Range("D47").Value
Cells(maLigne, 73) = WD.Range("A48").Value
Cells(maLigne, 74) = WD.Range("C48").Value
Cells(maLigne, 75) = WD.Range("D48").Value
Cells(maLigne, 76) = WD.Range("A49").Value
Cells(maLigne, 77) = WD.Range("C49").Value
Cells(maLigne, 78) = WD.Range("D49").Value
Cells(maLigne, 79) = WD.Range("A50").Value
Cells(maLigne, 80) = WD.Range("C50").Value
Cells(maLigne, 81) = WD.Range("D50").Value
Cells(maLigne, 82) = WD.Range("A51").Value
Cells(maLigne, 83) = WD.Range("C51").Value
Cells(maLigne, 84) = WD.Range("D51").Value
Cells(maLigne, 85) = WD.Range("A52").Value
Cells(maLigne, 86) = WD.Range("C52").Value
Cells(maLigne, 87) = WD.Range("D52").Value



'Adresse de facturation
Cells(maLigne, 88) = WD.Range("G45").Value
Cells(maLigne, 89) = WD.Range("G46").Value
Cells(maLigne, 90) = WD.Range("G47").Value
Cells(maLigne, 91) = WD.Range("G48").Value
Cells(maLigne, 92) = WD.Range("G49").Value
Cells(maLigne, 93) = WD.Range("G50").Value

'Choix du forfait
Cells(maLigne, 94) = WD.Range("G29").Value

MsgBox "Le devis " & WD.Range("n_devis").Value & " - " & WD.Range("B5").Value & " a bien été sauvegardé"
'**************************************************************************************************
Else
maLigne2 = Result.Row


'Coordonnées client
Cells(maLigne2, 1) = Range("n_devis").Value
Cells(maLigne2, 2) = WD.Range("F12").Value
Cells(maLigne2, 3) = WD.Range("B5").Value
Cells(maLigne2, 4) = WD.Range("B6").Value
Cells(maLigne2, 5) = WD.Range("B7").Value
Cells(maLigne2, 6) = WD.Range("B8").Value
Cells(maLigne2, 7) = WD.Range("B9").Value
Cells(maLigne2, 8) = WD.Range("F5").Value
Cells(maLigne2, 9) = WD.Range("F6").Value
Cells(maLigne2, 10) = WD.Range("F7").Value
Cells(maLigne2, 11) = WD.Range("F8").Value
Cells(maLigne2, 12) = WD.Range("F9").Value


'Détail du programme
Cells(maLigne2, 13) = WD.Range("G17").Value
Cells(maLigne2, 14) = WD.Range("A17").Value
Cells(maLigne2, 15) = WD.Range("C17").Value
Cells(maLigne2, 16) = WD.Range("D17").Value
Cells(maLigne2, 17) = WD.Range("E17").Value
Cells(maLigne2, 18) = WD.Range("G18").Value
Cells(maLigne2, 19) = WD.Range("A18").Value
Cells(maLigne2, 20) = WD.Range("C18").Value
Cells(maLigne2, 21) = WD.Range("D18").Value
Cells(maLigne2, 22) = WD.Range("E18").Value
Cells(maLigne2, 23) = WD.Range("G19").Value
Cells(maLigne2, 24) = WD.Range("A19").Value
Cells(maLigne2, 25) = WD.Range("C19").Value
Cells(maLigne2, 26) = WD.Range("D19").Value
Cells(maLigne2, 27) = WD.Range("E19").Value
Cells(maLigne2, 28) = WD.Range("G20").Value
Cells(maLigne2, 29) = WD.Range("A20").Value
Cells(maLigne2, 30) = WD.Range("C20").Value
Cells(maLigne2, 31) = WD.Range("D20").Value
Cells(maLigne2, 32) = WD.Range("E20").Value
Cells(maLigne2, 33) = WD.Range("G21").Value
Cells(maLigne2, 34) = WD.Range("A21").Value
Cells(maLigne2, 35) = WD.Range("C21").Value
Cells(maLigne2, 36) = WD.Range("D21").Value
Cells(maLigne2, 37) = WD.Range("E21").Value
Cells(maLigne2, 38) = WD.Range("G22").Value
Cells(maLigne2, 39) = WD.Range("A22").Value
Cells(maLigne2, 40) = WD.Range("C22").Value
Cells(maLigne2, 41) = WD.Range("D22").Value
Cells(maLigne2, 42) = WD.Range("E22").Value
Cells(maLigne2, 43) = WD.Range("G23").Value
Cells(maLigne2, 44) = WD.Range("A23").Value
Cells(maLigne2, 45) = WD.Range("C23").Value
Cells(maLigne2, 46) = WD.Range("D23").Value
Cells(maLigne2, 47) = WD.Range("E23").Value
Cells(maLigne2, 48) = WD.Range("G24").Value
Cells(maLigne2, 49) = WD.Range("A24").Value
Cells(maLigne2, 50) = WD.Range("C24").Value
Cells(maLigne2, 51) = WD.Range("D24").Value
Cells(maLigne2, 52) = WD.Range("E24").Value
Cells(maLigne2, 53) = WD.Range("G25").Value
Cells(maLigne2, 54) = WD.Range("A25").Value
Cells(maLigne2, 55) = WD.Range("C25").Value
Cells(maLigne2, 56) = WD.Range("D25").Value
Cells(maLigne2, 57) = WD.Range("E25").Value
Cells(maLigne2, 58) = WD.Range("G26").Value
Cells(maLigne2, 59) = WD.Range("A26").Value
Cells(maLigne2, 60) = WD.Range("C26").Value
Cells(maLigne2, 61) = WD.Range("D26").Value
Cells(maLigne2, 62) = WD.Range("E26").Value


'Descriptif
Cells(maLigne2, 63) = WD.Range("A31").Value


'Détails des coûts
Cells(maLigne2, 64) = WD.Range("A45").Value
Cells(maLigne2, 65) = WD.Range("C45").Value
Cells(maLigne2, 66) = WD.Range("D45").Value
Cells(maLigne2, 67) = WD.Range("A46").Value
Cells(maLigne2, 68) = WD.Range("C46").Value
Cells(maLigne2, 69) = WD.Range("D46").Value
Cells(maLigne2, 70) = WD.Range("A47").Value
Cells(maLigne2, 71) = WD.Range("C47").Value
Cells(maLigne2, 72) = WD.Range("D47").Value
Cells(maLigne2, 73) = WD.Range("A48").Value
Cells(maLigne2, 74) = WD.Range("C48").Value
Cells(maLigne2, 75) = WD.Range("D48").Value
Cells(maLigne2, 76) = WD.Range("A49").Value
Cells(maLigne2, 77) = WD.Range("C49").Value
Cells(maLigne2, 78) = WD.Range("D49").Value
Cells(maLigne2, 79) = WD.Range("A50").Value
Cells(maLigne2, 80) = WD.Range("C50").Value
Cells(maLigne2, 81) = WD.Range("D50").Value
Cells(maLigne2, 82) = WD.Range("A51").Value
Cells(maLigne2, 83) = WD.Range("C51").Value
Cells(maLigne2, 84) = WD.Range("D51").Value
Cells(maLigne2, 85) = WD.Range("A52").Value
Cells(maLigne2, 86) = WD.Range("C52").Value
Cells(maLigne2, 87) = WD.Range("D52").Value




'Adresse de facturation
Cells(maLigne2, 88) = WD.Range("G45").Value
Cells(maLigne2, 89) = WD.Range("G46").Value
Cells(maLigne2, 90) = WD.Range("G47").Value
Cells(maLigne2, 91) = WD.Range("G48").Value
Cells(maLigne2, 92) = WD.Range("G49").Value
Cells(maLigne2, 93) = WD.Range("G50").Value


'Choix du forfait
Cells(maLigne2, 94) = WD.Range("G29").Value


MsgBox "Le devis " & WD.Range("n_devis").Value & " - " & WD.Range("B5").Value & " a bien été modifié"
End If
'**************************************************************************************************
If MsgBox("Faire un nouveau devis pour " & WD.Range("B5").Value & "?", vbYesNo, "Demande de confirmation") = vbYes Then
Compteur
WD.Activate
Else


Worksheets("Accueil").Activate
WD.Visible = xlVeryHidden
Reset
End If


End If
Set PlageDeRecherche = Nothing
Set Result = Nothing
Set WP = Nothing
Set WD = Nothing
End Sub
 
Trier par date Trier par votes
B

bof

XLDnaute Occasionnel
Re : [VBA]Nettoyage de code

Bonjour,

C'est vrai qu'à première vue ça parait lamentable !
Cependant ce code à un avantage indéniable il est extrêmement lisible et y faire une modification ne demandera pas plus de 2 secondes.
Si on fait ce que tu demandes ça va rendre l'ensemble confus et rebutant.
Comme tu le dis toi-même ce code est satisfaisant, rapide et fonctionne bien.
Mon conseil est donc "Laisse le donc en l'état !"

A+

"Le mieux est l'ennemi du bien... (Vieux proverbe gaulois !)
 
Vote positif 0 Vote négatif
B

bof

XLDnaute Occasionnel
Re : [VBA]Nettoyage de code

Bonsoir,
Tu peux toujours essayer ça : (Hum... rien pu tester !!!)
Code: 
Sub galopin(maLigne&)
With Worksheets("Devis")
 'Coordonnées client
 Cells(maLigne, 1) = Range("n_devis").Value
 Cells(maLigne, 2) = .Range("F12").Value
 Cells(maLigne, 3) = .Range("B5").Value
 Cells(maLigne, 4) = .Range("B6").Value
 Cells(maLigne, 5) = .Range("B7").Value
 Cells(maLigne, 6) = .Range("B8").Value
 Cells(maLigne, 7) = .Range("B9").Value
 Cells(maLigne, 8) = .Range("F5").Value
 Cells(maLigne, 9) = .Range("F6").Value
 Cells(maLigne, 10) = .Range("F7").Value
 Cells(maLigne, 11) = .Range("F8").Value
 Cells(maLigne, 12) = .Range("F9").Value
'Détail du programme
For i = 13 To 58 Step 5
 Cells(maLigne, i) = .Range("G" & 17 + k).Value
 Cells(maLigne, i + 1) = .Range("A" & 17 + k).Value
 Cells(maLigne, i + 2) = .Range("C" & 17 + k).Value
 Cells(maLigne, i + 3) = .Range("D" & 17 + k).Value
 Cells(maLigne, i + 4) = .Range("E" & 17 + k).Value
 k = k + 1
Next
k = 0
 'Descriptif
 Cells(maLigne, 63) = .Range("A31").Value
'Détails des coûts
For i = 64 To 85 Step 3
 Cells(maLigne, i) = .Range("A" & 45 + k).Value
 Cells(maLigne, i + 1) = .Range("C" & 45 + k).Value
 Cells(maLigne, i + 2) = .Range("D" & 45 + k).Value
  k = k + 1
Next
 'Adresse de facturation
 Cells(maLigne, 88) = .Range("G45").Value
 Cells(maLigne, 89) = .Range("G46").Value
 Cells(maLigne, 90) = .Range("G47").Value
 Cells(maLigne, 91) = .Range("G48").Value
 Cells(maLigne, 92) = .Range("G49").Value
 Cells(maLigne, 93) = .Range("G50").Value

 'Choix du forfait
 Cells(maLigne, 94) = .Range("G29").Value
End With
End Sub
'_______________________________________________________________

Sub Sauvegarde()
Dim maLigne&, NomCherche$, Result As Range, PlageDeRecherche As Range
Dim WD As Worksheet, WP As Worksheet

Set WD = Worksheets("Devis")
Set WP = Worksheets("Planning")
'************************************************* *************************************************
'Vérifie si la date est mentionnée
    If WD.Range("date") = "" Then
       MsgBox "Veuillez sélectionner la date de l'événement."
       WD.Range("date").Select 'Se positionne sur la case Date
      
       'Vérifie si le nom du client est mentionné
    ElseIf WD.Range("B5") = "" Then
      MsgBox "Veuillez indiquer le nom du client."
      WD.Range("B5").Select 'Se positionne sur la case Client
    Else
       '************************************************* *************************************************
       'Détermine le numéro du devis à rechercher
       NomCherche = Range("n_devis").Value
       WP.Activate
       Set PlageDeRecherche = WP.Columns(1)
      
       Set Result = PlageDeRecherche.Cells.Find(what:=NomCherche, LookAt:=xlWhole)
      If Result Is Nothing Then
         maLigne = WP.Range("A" & Rows.Count).End(xlUp).Row + 1
         For a = 3 To 7
           For b = 5 To 9
              Cells(maLigne, a).Value = WD.Cells(b, 2).Value
           Next b
         Next a
            galopin
         MsgBox "Le devis " & WD.Range("n_devis").Value & " - " & WD.Range("B5").Value & " a bien été sauvegardé"
         '************************************************* *************************************************
      Else
         maLigne = Result.Row
            galopin
         MsgBox "Le devis " & WD.Range("n_devis").Value & " - " & WD.Range("B5").Value & " a bien été modifié"
      End If
      '************************************************* *************************************************
      If MsgBox("Faire un nouveau devis pour " & WD.Range("B5").Value & "?", vbYesNo, "Demande de confirmation") = vbYes Then
        Compteur
        WD.Activate
      Else
        Worksheets("Accueil").Activate
        WD.Visible = xlVeryHidden
        Reset
      End If
    End If
 Set PlageDeRecherche = Nothing
 Set Result = Nothing
 Set WP = Nothing
 Set WD = Nothing
 End Sub
A+
 
Vote positif 0 Vote négatif
Roland_M

Roland_M

XLDnaute Barbatruc
Re : [VBA]Nettoyage de code

bonjour à tous

perso, dans ce cas, je pratiquerai comme ceci:
(séparé pour rester lisible)

Code: 
'Coordonnées client
Cells(maLigne, 1) = Range("n_devis").Value
For I = 2 To 12
 Adres$ = Choose(I - 1, "F12", "B5", "B6", "B7", "B8", "B9", "F5", "F6", "F7", "F8", "F9")
 Cells(maLigne, I) = WD.Range(Adres$).Value
Next

'Détail du programme
For I = 13 To 62
 Adres$ = Choose(I - 12, "G17", "A17", "C17", "...") '< ici les adresses
 Cells(maLigne, I) = WD.Range(Adres$).Value
Next

'....
'....
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

J
  • Question
XL 2016 code vba pour envoie d'un email avec pièce jointe
Réponses
2
Affichages
2 K
jerome3131
J
K
  • Question
Microsoft 365 VBA - excel vers Acces
Réponses
0
Affichages
1 K
Keiko
K
A
  • Question
XL 2016 Correction Code VBA de débutant
Réponses
0
Affichages
1 K
AntoineLTO
A
P
  • Question
[VBA] Trouver le numéro de la ligne d'une cellule
Réponses
2
Affichages
4 K
powergirl
P
S
  • Question
Autres problème code vba avec le bouton supprimer et ajouter
Réponses
2
Affichages
1 K
sylvanu
sylvanu
D
  • Question
Procédure trop grande
2 3 4
Réponses
46
Affichages
9 K
domeli
D
7
  • Question
Accélération code vba
Réponses
6
Affichages
2 K
ROGER2327
ROGER2327
A
  • Question
VBA PB avec une partie de mon code
Réponses
2
Affichages
826
Arpette
A
R
  • Question
Erreur code VBA copie lignes
Réponses
3
Affichages
1 K
rudymagny
R

Membres actuellement en ligne

9 membres et 117 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 083
Messages
2 085 188
Membres
102 809
dernier inscrit
Sandrine83