Optimisation de code VBA

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
David Aubert

David Aubert

XLDnaute Barbatruc
Administrateur
Modérateur
Hello Cléa,
Peux tu stp m'optimiser ce code :
VB: 
VB:
Sub Ventes()

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Sheets("Export_ventes").Range("a2:f1000000").Clear

Sheets("Fichier facture client").Select
        
        
L = Sheets("Fichier facture client").Range("B" & Rows.Count).End(xlUp).Row + 1

For X = 2 To L

    v = Sheets("Export_ventes").Range("A" & Rows.Count).End(xlUp).Row + 1
    
    
    
    If Sheets("Fichier facture client").Range("AK" & X) = "FR" Then
    
    Sheets("Export_ventes").Range("A" & v) = Sheets("Fichier facture client").Range("L" & X).Value
    Sheets("Export_ventes").Range("B" & v) = Sheets("Fichier facture client").Range("M" & X).Value
    Sheets("Export_ventes").Range("C" & v) = Sheets("Fichier facture client").Range("N" & X).Value
    Sheets("Export_ventes").Range("D" & v) = Sheets("Fichier facture client").Range("O" & X).Value
    Sheets("Export_ventes").Range("E" & v) = Sheets("Fichier facture client").Range("U" & X).Value
    
    Sheets("Export_ventes").Range("A" & v + 1) = Sheets("Fichier facture client").Range("L" & X).Value
    Sheets("Export_ventes").Range("B" & v + 1) = Sheets("Fichier facture client").Range("M" & X).Value
    Sheets("Export_ventes").Range("C" & v + 1) = Sheets("Fichier facture client").Range("R" & X).Value
    Sheets("Export_ventes").Range("D" & v + 1) = Sheets("Fichier facture client").Range("O" & X).Value
    Sheets("Export_ventes").Range("F" & v + 1) = Sheets("Fichier facture client").Range("P" & X).Value
    
    Sheets("Export_ventes").Range("A" & v + 2) = Sheets("Fichier facture client").Range("L" & X).Value
    Sheets("Export_ventes").Range("B" & v + 2) = Sheets("Fichier facture client").Range("M" & X).Value
    Sheets("Export_ventes").Range("C" & v + 2) = "44571000"
    Sheets("Export_ventes").Range("D" & v + 2) = Sheets("Fichier facture client").Range("O" & X).Value
    Sheets("Export_ventes").Range("F" & v + 2) = Sheets("Fichier facture client").Range("T" & X).Value
    
    Else:
    
    If Sheets("Fichier facture client").Range("BB" & X) = "oui" Then
    
    
    
    Sheets("Export_ventes").Range("A" & v) = Sheets("Fichier facture client").Range("L" & X).Value
    Sheets("Export_ventes").Range("B" & v) = Sheets("Fichier facture client").Range("M" & X).Value
    Sheets("Export_ventes").Range("C" & v) = Sheets("Fichier facture client").Range("N" & X).Value
    Sheets("Export_ventes").Range("D" & v) = Sheets("Fichier facture client").Range("O" & X).Value
    Sheets("Export_ventes").Range("E" & v) = Sheets("Fichier facture client").Range("U" & X).Value
    
    Sheets("Export_ventes").Range("A" & v + 1) = Sheets("Fichier facture client").Range("L" & X).Value
    Sheets("Export_ventes").Range("B" & v + 1) = Sheets("Fichier facture client").Range("M" & X).Value
    Sheets("Export_ventes").Range("C" & v + 1) = Sheets("Fichier facture client").Range("R" & X).Value
    Sheets("Export_ventes").Range("D" & v + 1) = Sheets("Fichier facture client").Range("O" & X).Value
    Sheets("Export_ventes").Range("F" & v + 1) = Sheets("Fichier facture client").Range("P" & X).Value
    
    Sheets("Export_ventes").Range("A" & v + 2) = Sheets("Fichier facture client").Range("L" & X).Value
    Sheets("Export_ventes").Range("B" & v + 2) = Sheets("Fichier facture client").Range("M" & X).Value
    Sheets("Export_ventes").Range("C" & v + 2) = "44520000"
    Sheets("Export_ventes").Range("D" & v + 2) = Sheets("Fichier facture client").Range("O" & X).Value
    Sheets("Export_ventes").Range("E" & v + 2) = Sheets("Fichier facture client").Range("T" & X).Value
    
    Sheets("Export_ventes").Range("A" & v + 3) = Sheets("Fichier facture client").Range("L" & X).Value
    Sheets("Export_ventes").Range("B" & v + 3) = Sheets("Fichier facture client").Range("M" & X).Value
    Sheets("Export_ventes").Range("C" & v + 3) = "44529000"
    Sheets("Export_ventes").Range("D" & v + 3) = Sheets("Fichier facture client").Range("O" & X).Value
    Sheets("Export_ventes").Range("F" & v + 3) = Sheets("Fichier facture client").Range("T" & X).Value
        
     Else:
    
    Sheets("Export_ventes").Range("A" & v) = Sheets("Fichier facture client").Range("L" & X).Value
    Sheets("Export_ventes").Range("B" & v) = Sheets("Fichier facture client").Range("M" & X).Value
    Sheets("Export_ventes").Range("C" & v) = Sheets("Fichier facture client").Range("N" & X).Value
    Sheets("Export_ventes").Range("D" & v) = Sheets("Fichier facture client").Range("O" & X).Value
    Sheets("Export_ventes").Range("E" & v) = Sheets("Fichier facture client").Range("U" & X).Value
    
    Sheets("Export_ventes").Range("A" & v + 1) = Sheets("Fichier facture client").Range("L" & X).Value
    Sheets("Export_ventes").Range("B" & v + 1) = Sheets("Fichier facture client").Range("M" & X).Value
    Sheets("Export_ventes").Range("C" & v + 1) = Sheets("Fichier facture client").Range("R" & X).Value
    Sheets("Export_ventes").Range("D" & v + 1) = Sheets("Fichier facture client").Range("O" & X).Value
    Sheets("Export_ventes").Range("F" & v + 1) = Sheets("Fichier facture client").Range("P" & X).Value
    
    Sheets("Export_ventes").Range("A" & v + 2) = Sheets("Fichier facture client").Range("L" & X).Value
    Sheets("Export_ventes").Range("B" & v + 2) = Sheets("Fichier facture client").Range("M" & X).Value
    Sheets("Export_ventes").Range("C" & v + 2) = "44571000"
    Sheets("Export_ventes").Range("D" & v + 2) = Sheets("Fichier facture client").Range("O" & X).Value
    Sheets("Export_ventes").Range("F" & v + 2) = Sheets("Fichier facture client").Range("T" & X).Value
    

    
     End If
     End If
    
    
    Next X
    
    Application.ScreenUpdating = True
    
    MsgBox ("Ecritures exportées avec succès sur la feuille 'Export_ventes'")
    
    Application.DisplayAlerts = True
    
End Sub

Merci d'avance
 
David Aubert à dit:
Hello Cléa,
Peux tu stp m'optimiser ce code :
VB: 
VB:
Sub Ventes()

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Sheets("Export_ventes").Range("a2:f1000000").Clear

Sheets("Fichier facture client").Select
        
        
L = Sheets("Fichier facture client").Range("B" & Rows.Count).End(xlUp).Row + 1

For X = 2 To L

    v = Sheets("Export_ventes").Range("A" & Rows.Count).End(xlUp).Row + 1
    
    
    
    If Sheets("Fichier facture client").Range("AK" & X) = "FR" Then
    
    Sheets("Export_ventes").Range("A" & v) = Sheets("Fichier facture client").Range("L" & X).Value
    Sheets("Export_ventes").Range("B" & v) = Sheets("Fichier facture client").Range("M" & X).Value
    Sheets("Export_ventes").Range("C" & v) = Sheets("Fichier facture client").Range("N" & X).Value
    Sheets("Export_ventes").Range("D" & v) = Sheets("Fichier facture client").Range("O" & X).Value
    Sheets("Export_ventes").Range("E" & v) = Sheets("Fichier facture client").Range("U" & X).Value
    
    Sheets("Export_ventes").Range("A" & v + 1) = Sheets("Fichier facture client").Range("L" & X).Value
    Sheets("Export_ventes").Range("B" & v + 1) = Sheets("Fichier facture client").Range("M" & X).Value
    Sheets("Export_ventes").Range("C" & v + 1) = Sheets("Fichier facture client").Range("R" & X).Value
    Sheets("Export_ventes").Range("D" & v + 1) = Sheets("Fichier facture client").Range("O" & X).Value
    Sheets("Export_ventes").Range("F" & v + 1) = Sheets("Fichier facture client").Range("P" & X).Value
    
    Sheets("Export_ventes").Range("A" & v + 2) = Sheets("Fichier facture client").Range("L" & X).Value
    Sheets("Export_ventes").Range("B" & v + 2) = Sheets("Fichier facture client").Range("M" & X).Value
    Sheets("Export_ventes").Range("C" & v + 2) = "44571000"
    Sheets("Export_ventes").Range("D" & v + 2) = Sheets("Fichier facture client").Range("O" & X).Value
    Sheets("Export_ventes").Range("F" & v + 2) = Sheets("Fichier facture client").Range("T" & X).Value
    
    Else:
    
    If Sheets("Fichier facture client").Range("BB" & X) = "oui" Then
    
    
    
    Sheets("Export_ventes").Range("A" & v) = Sheets("Fichier facture client").Range("L" & X).Value
    Sheets("Export_ventes").Range("B" & v) = Sheets("Fichier facture client").Range("M" & X).Value
    Sheets("Export_ventes").Range("C" & v) = Sheets("Fichier facture client").Range("N" & X).Value
    Sheets("Export_ventes").Range("D" & v) = Sheets("Fichier facture client").Range("O" & X).Value
    Sheets("Export_ventes").Range("E" & v) = Sheets("Fichier facture client").Range("U" & X).Value
    
    Sheets("Export_ventes").Range("A" & v + 1) = Sheets("Fichier facture client").Range("L" & X).Value
    Sheets("Export_ventes").Range("B" & v + 1) = Sheets("Fichier facture client").Range("M" & X).Value
    Sheets("Export_ventes").Range("C" & v + 1) = Sheets("Fichier facture client").Range("R" & X).Value
    Sheets("Export_ventes").Range("D" & v + 1) = Sheets("Fichier facture client").Range("O" & X).Value
    Sheets("Export_ventes").Range("F" & v + 1) = Sheets("Fichier facture client").Range("P" & X).Value
    
    Sheets("Export_ventes").Range("A" & v + 2) = Sheets("Fichier facture client").Range("L" & X).Value
    Sheets("Export_ventes").Range("B" & v + 2) = Sheets("Fichier facture client").Range("M" & X).Value
    Sheets("Export_ventes").Range("C" & v + 2) = "44520000"
    Sheets("Export_ventes").Range("D" & v + 2) = Sheets("Fichier facture client").Range("O" & X).Value
    Sheets("Export_ventes").Range("E" & v + 2) = Sheets("Fichier facture client").Range("T" & X).Value
    
    Sheets("Export_ventes").Range("A" & v + 3) = Sheets("Fichier facture client").Range("L" & X).Value
    Sheets("Export_ventes").Range("B" & v + 3) = Sheets("Fichier facture client").Range("M" & X).Value
    Sheets("Export_ventes").Range("C" & v + 3) = "44529000"
    Sheets("Export_ventes").Range("D" & v + 3) = Sheets("Fichier facture client").Range("O" & X).Value
    Sheets("Export_ventes").Range("F" & v + 3) = Sheets("Fichier facture client").Range("T" & X).Value
        
     Else:
    
    Sheets("Export_ventes").Range("A" & v) = Sheets("Fichier facture client").Range("L" & X).Value
    Sheets("Export_ventes").Range("B" & v) = Sheets("Fichier facture client").Range("M" & X).Value
    Sheets("Export_ventes").Range("C" & v) = Sheets("Fichier facture client").Range("N" & X).Value
    Sheets("Export_ventes").Range("D" & v) = Sheets("Fichier facture client").Range("O" & X).Value
    Sheets("Export_ventes").Range("E" & v) = Sheets("Fichier facture client").Range("U" & X).Value
    
    Sheets("Export_ventes").Range("A" & v + 1) = Sheets("Fichier facture client").Range("L" & X).Value
    Sheets("Export_ventes").Range("B" & v + 1) = Sheets("Fichier facture client").Range("M" & X).Value
    Sheets("Export_ventes").Range("C" & v + 1) = Sheets("Fichier facture client").Range("R" & X).Value
    Sheets("Export_ventes").Range("D" & v + 1) = Sheets("Fichier facture client").Range("O" & X).Value
    Sheets("Export_ventes").Range("F" & v + 1) = Sheets("Fichier facture client").Range("P" & X).Value
    
    Sheets("Export_ventes").Range("A" & v + 2) = Sheets("Fichier facture client").Range("L" & X).Value
    Sheets("Export_ventes").Range("B" & v + 2) = Sheets("Fichier facture client").Range("M" & X).Value
    Sheets("Export_ventes").Range("C" & v + 2) = "44571000"
    Sheets("Export_ventes").Range("D" & v + 2) = Sheets("Fichier facture client").Range("O" & X).Value
    Sheets("Export_ventes").Range("F" & v + 2) = Sheets("Fichier facture client").Range("T" & X).Value
    

    
     End If
     End If
    
    
    Next X
    
    Application.ScreenUpdating = True
    
    MsgBox ("Ecritures exportées avec succès sur la feuille 'Export_ventes'")
    
    Application.DisplayAlerts = True
    
End Sub

Merci d'avance
Cliquez pour agrandir...
Pour optimiser le code VBA fourni, je peux vous suggérer quelques améliorations et simplifications. Ces optimisations peuvent inclure la réduction de redondances, l'amélioration de la lisibilité et l'augmentation de l'efficacité.

Voici une version optimisée de votre code :

```vb
Sub VentesOptimise()

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim wsExport As Worksheet
Dim wsFacture As Worksheet
Dim L As Long, X As Long, v As Long
Dim codeSpecial As String

Set wsExport = Sheets("Export_ventes")
Set wsFacture = Sheets("Fichier facture client")

wsExport.Range("A2:F1000000").Clear

L = wsFacture.Range("B" & Rows.Count).End(xlUp).Row + 1

For X = 2 To L
v = wsExport.Range("A" & Rows.Count).End(xlUp).Row + 1

With wsFacture
If .Range("AK" & X).Value = "FR" Then
codeSpecial = "44571000"
ElseIf .Range("BB" & X).Value = "oui" Then
codeSpecial = "44529000"
' Ligne 1
CopierValeurs .Range("L" & X), .Range("M" & X), .Range("N" & X), .Range("O" & X), .Range("U" & X), wsExport, v
' Ligne 2
CopierValeurs .Range("L" & X), .Range("M" & X), .Range("R" & X), .Range("O" & X), .Range("P" & X), wsExport, v + 1
' Ligne 3
CopierValeurs .Range("L" & X), .Range("M" & X), "44520000", .Range("O" & X), .Range("T" & X), wsExport, v + 2
Else
codeSpecial = "44571000"
End If

' Ligne 1
CopierValeurs .Range("L" & X), .Range("M" & X), .Range("N" & X), .Range("O" & X), .Range("U" & X), wsExport, v
' Ligne 2
CopierValeurs .Range("L" & X), .Range("M" & X), .Range("R" & X), .Range("O" & X), .Range("P" & X), wsExport, v + 1
' Ligne spéciale
CopierValeurs .Range("L" & X), .Range("M" & X), codeSpecial, .Range("O" & X), .Range("T" & X), wsExport, v + IIf(.Range("AK" & X).Value <> "FR", 1, 0) + 2
End With
Next X

Application.ScreenUpdating = True
MsgBox "Ecritures exportées avec succès sur la feuille 'Export_ventes'"
Application.DisplayAlerts = True

End Sub

Sub CopierValeurs(val1 As Range, val2 As Range, val3 As Variant, val4 As Range, val5 As Range, ws As Worksheet, vOffset As Long)
With ws
.Range("A" & vOffset).Value = val1.Value
.Range("B" & vOffset).Value = val2.Value
.Range("C" & vOffset).Value = val3
.Range("D" & vOffset).Value = val4.Value
.Range("E" & vOffset).Value = val5.Value
End With
End Sub
```

### Explications des améliorations :

1. **Factorisation du Code Redondant** : J'ai créé une fonction `CopierValeurs` pour regrouper les lignes de code qui faisaient la même opération dans l'ensemble des cases. Cela simplifie le code et le rend plus lisible.

2. **Utilisation des Objets `Worksheet`** : Plutôt que de sélectionner des feuilles, définissez-les comme objets. Ceci rend le code plus propre et améliore légèrement les performances.

3. **Définir les Codes** : J'ai utilisé des variables pour conserver des valeurs comme `codeSpecial` afin de simplifier les conditions et réduire les répétitions.

Ces modifications rendent le code plus compact, plus lisible, et potentiellement plus rapide à exécuter.
 
Merci, peux tu stp mettre le code optimisé entre les balsises "
VB: 
VB:" et code "
" dans ta réponse s'il te plait?
Ce sera plus facile à lire et à réutiliser.
 
David Aubert à dit:
Merci, peux tu stp mettre le code optimisé entre les balsises "
VB: 
VB:" et code "
" dans ta réponse s'il te plait?
Ce sera plus facile à lire et à réutiliser.
Cliquez pour agrandir...
Bien sûr ! Voici le code optimisé avec les balises `
VB: 
VB:` et `
` :

VB: 
VB:
Sub VentesOptimise()

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    Dim wsExport As Worksheet
    Dim wsFacture As Worksheet
    Dim L As Long, X As Long, v As Long
    Dim codeSpecial As String

    Set wsExport = Sheets("Export_ventes")
    Set wsFacture = Sheets("Fichier facture client")

    wsExport.Range("A2:F1000000").Clear

    L = wsFacture.Range("B" & Rows.Count).End(xlUp).Row + 1

    For X = 2 To L
        v = wsExport.Range("A" & Rows.Count).End(xlUp).Row + 1

        With wsFacture
            If .Range("AK" & X).Value = "FR" Then
                codeSpecial = "44571000"
            ElseIf .Range("BB" & X).Value = "oui" Then
                codeSpecial = "44529000"
                ' Ligne 1
                CopierValeurs .Range("L" & X), .Range("M" & X), .Range("N" & X), .Range("O" & X), .Range("U" & X), wsExport, v
                ' Ligne 2
                CopierValeurs .Range("L" & X), .Range("M" & X), .Range("R" & X), .Range("O" & X), .Range("P" & X), wsExport, v + 1
                ' Ligne 3
                CopierValeurs .Range("L" & X), .Range("M" & X), "44520000", .Range("O" & X), .Range("T" & X), wsExport, v + 2
            Else
                codeSpecial = "44571000"
            End If

            ' Ligne 1
            CopierValeurs .Range("L" & X), .Range("M" & X), .Range("N" & X), .Range("O" & X), .Range("U" & X), wsExport, v
            ' Ligne 2
            CopierValeurs .Range("L" & X), .Range("M" & X), .Range("R" & X), .Range("O" & X), .Range("P" & X), wsExport, v + 1
            ' Ligne spéciale
            CopierValeurs .Range("L" & X), .Range("M" & X), codeSpecial, .Range("O" & X), .Range("T" & X), wsExport, v + IIf(.Range("AK" & X).Value <> "FR", 1, 0) + 2
        End With
    Next X

    Application.ScreenUpdating = True
    MsgBox "Ecritures exportées avec succès sur la feuille 'Export_ventes'"
    Application.DisplayAlerts = True

End Sub

Sub CopierValeurs(val1 As Range, val2 As Range, val3 As Variant, val4 As Range, val5 As Range, ws As Worksheet, vOffset As Long)
    With ws
        .Range("A" & vOffset).Value = val1.Value
        .Range("B" & vOffset).Value = val2.Value
        .Range("C" & vOffset).Value = val3
        .Range("D" & vOffset).Value = val4.Value
        .Range("E" & vOffset).Value = val5.Value
    End With
End Sub
 
Je vois que j'ai écrit n'importe quoi... mais tu as compris, c'est au delà de mes espérances!!
 
David Aubert à dit:
Je vois que j'ai écrit n'importe quoi... mais tu as compris, c'est au delà de mes espérances!!
Cliquez pour agrandir...
Je suis ravi d'avoir pu vous aider et que cela dépasse vos attentes ! Si vous avez d'autres questions ou besoin de plus d'assistance, n'hésitez pas à demander. 😊
 
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

R
  • Question Question
XL 2021 Optimisation Code VBA
Réponses
10
Affichages
649
Dranreb
Dranreb
D
  • Résolu(e)
XL 2019 Nouveau Numéro
2 3 4
Réponses
57
Affichages
2 K
patricktoulon
patricktoulon
Cédric06400
  • Résolu(e)
XL 2021 Revenir sur Excel
Réponses
6
Affichages
431
Franc58
F
ph.vanne
  • Question Question
Autres fenêtre "Publication"
Réponses
10
Affichages
470
ph.vanne
ph.vanne
S
  • Résolu(e)
Microsoft 365 Mailing mise en forme HTML : revenir à la ligne automatique si trop de texte saisie
2
Réponses
17
Affichages
191
spike29
S
F
  • Question Question
Microsoft 365 aide VBA excel
Réponses
4
Affichages
358
Oneida
Oneida
Chaton77
  • Résolu(e)
Microsoft 365 Vba : Transférer des données d'un tableau dans un autre fichier
Réponses
7
Affichages
477
Chaton77
Chaton77
S
  • Résolu(e)
Microsoft 365 Ecrasement d'une ligne si déjà existante
Réponses
2
Affichages
195
sebastien176
S
J
  • Question Question
Microsoft 365 Code VBA
Réponses
10
Affichages
792
jebibo
J
G
  • Résolu(e)
XL 2010 Obliger la validation d'un bouton d'option.
Réponses
8
Affichages
363
gillesda
G
F
  • Question Question
Microsoft 365 Problème avec VBA ( Résolu)
Réponses
2
Affichages
338
firecarl
F
klin89
  • Question Question
Microsoft 365 Méthode Evaluate pour se dispenser d'une boucle imbriquée
Réponses
14
Affichages
393
patricktoulon
patricktoulon
lynyrd
  • Question Question
XL 2019 code pour tous les disques
Réponses
3
Affichages
595
AtTheOne
AtTheOne
S
  • Résolu(e)
XL 2019 VBA automatiser hauteur de lignes
Réponses
7
Affichages
187
sofmat
S
L
  • Question Question
Microsoft 365 Faire agir une macro en fonction de l'emplacement du bouton
Réponses
2
Affichages
374
AtTheOne
AtTheOne
A
  • Question Question
VBA qui fonctionnait avant, mais ne fonctionne plus avec le 64 bits
Réponses
2
Affichages
216
patricktoulon
patricktoulon
L
  • Question Question
VBA : erreur sur boucle
Réponses
2
Affichages
301
Latias
L
J
  • Question Question
Microsoft 365 Probléme VBA
Réponses
8
Affichages
230
jalaba
J
S
  • Résolu(e)
Microsoft 365 VBA Match: comment éviter l'erreur?
2
Réponses
29
Affichages
545
Dranreb
Dranreb
B
  • Résolu(e)
Microsoft 365 creation d'liste à imprimer
2 3 4
Réponses
51
Affichages
1 K
Banbara
B
Retour