XL 2010 rendre code vba rapide

Créer une discussion
Répondre

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
H

Hafi.alaoui

XLDnaute Junior
comment rendre un code vba un peu rapide ou reduit?
j'ai ce code qui est très très lent:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ligne As Long, C As Range, Ctr As Long
If Target.Address = "$A$1" And Target.Count = 1 Then
With Sheets("Clients")
If IsNumeric(Application.Match(Target.Value, [Clients!A:A], 0)) Then
ligne = Application.Match(Target.Value, [Clients!A:A], 0)
[C5:C9,E8:E9,B11,F11:F24,F27,F28,F29,F30,F31,F32].Value = ""
Application.EnableEvents = False
On Error Resume Next
[C5] = .Cells(ligne, 3)
[C6] = .Cells(ligne, 4)
[C7] = .Cells(ligne, 5)
[C8] = "'" & .Cells(ligne, 6)
[C9] = "Al-Hoceima le:" & Date
[E8] = .Cells(ligne, "K")
[E9] = .Cells(ligne, "L")
[B16] = .Cells(ligne, "S")
[B17] = .Cells(ligne, "W")
[B18] = .Cells(ligne, "AA")
[B19] = .Cells(ligne, "AE")
[B20] = .Cells(ligne, "AI")
[B21] = .Cells(ligne, "AM")
[B22] = .Cells(ligne, "AQ")
[B23] = .Cells(ligne, "AU")
[B24] = .Cells(ligne, "AY")
[B25] = .Cells(ligne, "BC")
[B26] = .Cells(ligne, "BG")
[C30] = .Cells(ligne, "BK")
[C11] = .Cells(ligne, 10)
If [C11] <> "" Then
[D11] = .Cells(ligne, 15)
[E11] = .Cells(ligne, 18)
End If
If [D11] <> "" And [E11] <> "" Then
[F11] = [D11] * [E11] * [Home!M5]
End If
[C12] = .Cells(ligne, 9)
If [C12] <> "" Then
[D12] = .Cells(ligne, 14)
[E12] = .Cells(ligne, 17)
End If
If [D12] <> "" And [E12] <> "" Then
[F12] = [D12] * [E12] * [Home!M5]
End If
[C13] = .Cells(ligne, 8)
If [C13] <> "" Then
[D13] = .Cells(ligne, 13)
[E13] = .Cells(ligne, 16)
End If
If [D13] <> "" And [E13] <> "" Then
[F13] = [D13] * [E13] * [Home!M5]
End If
On Error Resume Next
[C16] = .Cells(ligne, 20)
If [C16] <> "" Then
[D16] = .Cells(ligne, 21)
[E16] = .Cells(ligne, 22)
End If
If [D16] <> "" And [E16] <> "" Then
[F16] = [D16 * E16]
End If
[C17] = .Cells(ligne, 24)
If [C17] <> "" Then
[D17] = .Cells(ligne, 25)
[E17] = .Cells(ligne, 26)
End If
If [D17] <> "" And [E17] <> "" Then
[F17] = [D17 * E17]
End If
[C18] = .Cells(ligne, 28)
If [C18] <> "" Then
[D18] = .Cells(ligne, 29)
[E18] = .Cells(ligne, 30)
End If
If [D18] <> "" And [E18] <> "" Then
[F18] = [D18 * E18]
End If
[C19] = .Cells(ligne, 32)
If [C19] <> "" Then
[D19] = .Cells(ligne, 33)
[E19] = .Cells(ligne, 34)
End If
If [D19] <> "" And [E19] <> "" Then
[F19] = [D19 * E19]
End If
[C20] = .Cells(ligne, 36)
If [C20] <> "" Then
[D20] = .Cells(ligne, 37)
[E20] = .Cells(ligne, 38)
End If
If [D20] <> "" And [E20] <> "" Then
[F20] = [D20 * E20]
End If
[C21] = .Cells(ligne, 40)
If [C21] <> "" Then
[D21] = .Cells(ligne, 41)
[E21] = .Cells(ligne, 42)
End If
If [D21] <> "" And [E21] <> "" Then
[F21] = [D21 * E21]
End If
[C22] = .Cells(ligne, 44)
If [C22] <> "" Then
[D22] = .Cells(ligne, 45)
[E22] = .Cells(ligne, 46)
End If
If [D22] <> "" And [E22] <> "" Then
[F22] = [D22 * E22]
End If
[C23] = .Cells(ligne, 48)
If [C23] <> "" Then
[D23] = .Cells(ligne, 49)
[E23] = .Cells(ligne, 50)
End If
If [D23] <> "" And [E23] <> "" Then
[F23] = [D23 * E23]
End If
[C24] = .Cells(ligne, 52)
If [C24] <> "" Then
[D24] = .Cells(ligne, 53)
[E24] = .Cells(ligne, 54)
End If
If [D24] <> "" And [E24] <> "" Then
[F24] = [D24 * E24]
End If
[C25] = .Cells(ligne, 56)
If [C25] <> "" Then
[D25] = .Cells(ligne, 57)
[E25] = .Cells(ligne, 58)
End If
If [D25] <> "" And [E25] <> "" Then
[F25] = [D25 * E25]
End If

[C26] = .Cells(ligne, 60)
If [C26] <> "" Then
[D26] = .Cells(ligne, 61)
[E26] = .Cells(ligne, 62)
End If
If [D26] <> "" And [E26] <> "" Then
[F26] = [D26 * E26]
End If
If [F31] > 0 Then
[F29] = [F28 - F31] / 1.1
[F30] = [F29] * 0.1
End If
If [E8] > 0 Then [E14] = 9
End If
If [E8] < "" Then [E14] = ""
[C14] = ""
[E31] = ""
[D8] = ""
[D9] = ""
[C4] = [A1]
[D7:E7] = "Durée de " & [Home!M5] & " Jour(s)"
[D14] = [D13] * [Home!M7] + [D12] * [Home!M8] + [D11] * [Home!M9]
[F14] = IIf([Home!M5] <> "", [D14] * [E14] * [Home!M5 ], [D14] * [E14])
[F31] = [F14]
If [F31] = "" Then
[F29] = [F28] / 1.1
[F30] = [F29] * 0.1
End If
[F28] = Application.Sum([F11:F27])
[F29] = ([F28] - [F31]) / 1.1
[F30] = [F29] / 10
If Ctr > 0 Then [F31] = Ctr
[F33] = Application.Sum([F28,F32])
Application.EnableEvents = True
facturer
End With
End If
End Sub
 
Trier par date Trier par votes
yahya.be à dit:
comment rendre un code vba un peu rapide ou reduit?
j'ai ce code qui est très très lent:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ligne As Long, C As Range, Ctr As Long
If Target.Address = "$A$1" And Target.Count = 1 Then
With Sheets("Clients")
If IsNumeric(Application.Match(Target.Value, [Clients!A:A], 0)) Then
ligne = Application.Match(Target.Value, [Clients!A:A], 0)
[C5:C9,E8:E9,B11,F11:F24,F27,F28,F29,F30,F31,F32].Value = ""
Application.EnableEvents = False
On Error Resume Next
[C5] = .Cells(ligne, 3)
[C6] = .Cells(ligne, 4)
[C7] = .Cells(ligne, 5)
[C8] = "'" & .Cells(ligne, 6)
[C9] = "Al-Hoceima le:" & Date
[E8] = .Cells(ligne, "K")
[E9] = .Cells(ligne, "L")
[B16] = .Cells(ligne, "S")
[B17] = .Cells(ligne, "W")
[B18] = .Cells(ligne, "AA")
[B19] = .Cells(ligne, "AE")
[B20] = .Cells(ligne, "AI")
[B21] = .Cells(ligne, "AM")
[B22] = .Cells(ligne, "AQ")
[B23] = .Cells(ligne, "AU")
[B24] = .Cells(ligne, "AY")
[B25] = .Cells(ligne, "BC")
[B26] = .Cells(ligne, "BG")
[C30] = .Cells(ligne, "BK")
[C11] = .Cells(ligne, 10)
If [C11] <> "" Then
[D11] = .Cells(ligne, 15)
[E11] = .Cells(ligne, 18)
End If
If [D11] <> "" And [E11] <> "" Then
[F11] = [D11] * [E11] * [Home!M5]
End If
[C12] = .Cells(ligne, 9)
If [C12] <> "" Then
[D12] = .Cells(ligne, 14)
[E12] = .Cells(ligne, 17)
End If
If [D12] <> "" And [E12] <> "" Then
[F12] = [D12] * [E12] * [Home!M5]
End If
[C13] = .Cells(ligne, 8)
If [C13] <> "" Then
[D13] = .Cells(ligne, 13)
[E13] = .Cells(ligne, 16)
End If
If [D13] <> "" And [E13] <> "" Then
[F13] = [D13] * [E13] * [Home!M5]
End If
On Error Resume Next
[C16] = .Cells(ligne, 20)
If [C16] <> "" Then
[D16] = .Cells(ligne, 21)
[E16] = .Cells(ligne, 22)
End If
If [D16] <> "" And [E16] <> "" Then
[F16] = [D16 * E16]
End If
[C17] = .Cells(ligne, 24)
If [C17] <> "" Then
[D17] = .Cells(ligne, 25)
[E17] = .Cells(ligne, 26)
End If
If [D17] <> "" And [E17] <> "" Then
[F17] = [D17 * E17]
End If
[C18] = .Cells(ligne, 28)
If [C18] <> "" Then
[D18] = .Cells(ligne, 29)
[E18] = .Cells(ligne, 30)
End If
If [D18] <> "" And [E18] <> "" Then
[F18] = [D18 * E18]
End If
[C19] = .Cells(ligne, 32)
If [C19] <> "" Then
[D19] = .Cells(ligne, 33)
[E19] = .Cells(ligne, 34)
End If
If [D19] <> "" And [E19] <> "" Then
[F19] = [D19 * E19]
End If
[C20] = .Cells(ligne, 36)
If [C20] <> "" Then
[D20] = .Cells(ligne, 37)
[E20] = .Cells(ligne, 38)
End If
If [D20] <> "" And [E20] <> "" Then
[F20] = [D20 * E20]
End If
[C21] = .Cells(ligne, 40)
If [C21] <> "" Then
[D21] = .Cells(ligne, 41)
[E21] = .Cells(ligne, 42)
End If
If [D21] <> "" And [E21] <> "" Then
[F21] = [D21 * E21]
End If
[C22] = .Cells(ligne, 44)
If [C22] <> "" Then
[D22] = .Cells(ligne, 45)
[E22] = .Cells(ligne, 46)
End If
If [D22] <> "" And [E22] <> "" Then
[F22] = [D22 * E22]
End If
[C23] = .Cells(ligne, 48)
If [C23] <> "" Then
[D23] = .Cells(ligne, 49)
[E23] = .Cells(ligne, 50)
End If
If [D23] <> "" And [E23] <> "" Then
[F23] = [D23 * E23]
End If
[C24] = .Cells(ligne, 52)
If [C24] <> "" Then
[D24] = .Cells(ligne, 53)
[E24] = .Cells(ligne, 54)
End If
If [D24] <> "" And [E24] <> "" Then
[F24] = [D24 * E24]
End If
[C25] = .Cells(ligne, 56)
If [C25] <> "" Then
[D25] = .Cells(ligne, 57)
[E25] = .Cells(ligne, 58)
End If
If [D25] <> "" And [E25] <> "" Then
[F25] = [D25 * E25]
End If

[C26] = .Cells(ligne, 60)
If [C26] <> "" Then
[D26] = .Cells(ligne, 61)
[E26] = .Cells(ligne, 62)
End If
If [D26] <> "" And [E26] <> "" Then
[F26] = [D26 * E26]
End If
If [F31] > 0 Then
[F29] = [F28 - F31] / 1.1
[F30] = [F29] * 0.1
End If
If [E8] > 0 Then [E14] = 9
End If
If [E8] < "" Then [E14] = ""
[C14] = ""
[E31] = ""
[D8] = ""
[D9] = ""
[C4] = [A1]
[D7:E7] = "Durée de " & [Home!M5] & " Jour(s)"
[D14] = [D13] * [Home!M7] + [D12] * [Home!M8] + [D11] * [Home!M9]
[F14] = IIf([Home!M5] <> "", [D14] * [E14] * [Home!M5 ], [D14] * [E14])
[F31] = [F14]
If [F31] = "" Then
[F29] = [F28] / 1.1
[F30] = [F29] * 0.1
End If
[F28] = Application.Sum([F11:F27])
[F29] = ([F28] - [F31]) / 1.1
[F30] = [F29] / 10
If Ctr > 0 Then [F31] = Ctr
[F33] = Application.Sum([F28,F32])
Application.EnableEvents = True
facturer
End With
End If
End Sub
Cliquez pour agrandir...
c'est vra ce que vous suggérez,mais c'est pour une facture en vba,comment faire pour tableau dynamique?
 
Vote positif 0 Vote négatif
bonjour
commence déjà par faire un match sur ce qui est necessaire

montableau=sheets("Client").range("A1",sheets("Client").cells(rows.count,"A").end(xlup)).value
If IsNumeric(Application.Match(Target.Value,montableau, 0)) Then
ligne = Application.Match(Target.Value,montableau, 0)

ensuite utiliser l’écriture des cellules avec les crochets utilise beaucoup de mémoire car tu demande a vba de faire la différence entre evaluate et une cellule en effet l’écriture "[xxx]" est une abréviation de de evaluate(xxx)
 
Vote positif 0 Vote négatif
Bonjour.
Je pense que ce serait plus simple avec des formules de la forme genre, en C4 :
Code: 
=LCli Clients!$A:$A
et la Workseet_Change simplement comme ça :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim Ligne
   If Target.Address = "$A$1" Then
      Ligne = Application.Match(Target.Value, [Clients!A:A], 0)
      If IsNumeric(Ligne) Then Me.Names.Add "LCli", ThisWorkbook.Worksheets("Clients").Rows(Ligne)
      End If
   End Sub
 
Vote positif 0 Vote négatif
Bonjour le fil, bonjour el forum,

patricktoulon à dit:
utiliser l’écriture des cellules avec les crochets utilise beaucoup de mémoire car tu demande a vba de faire la différence entre evaluate et une cellule en effet l’écriture "[xxx]" est une abréviation de de evaluate(xxx)
Cliquez pour agrandir...

Merci pour cette précieuse indication que j'ignorais !... Toujours aussi bon le Patrick !
 
Vote positif 0 Vote négatif
Oui mais Evaluate n'évalue que le sens de l'expression spécifiée, et renvoie donc un objet Range s'il peut la représenter, et non sa valeur.
Tout comme pour les méthodes Range et Cells, pour une seule cellule chaque fois, celle ci est trop longue à exécuter, mais guère plus qu'elles, à ne jamais utiliser massivement non plus.
 
Vote positif 0 Vote négatif
patricktoulon à dit:
bonjour
commence déjà par faire un match sur ce qui est necessaire

montableau=sheets("Client").range("A1",sheets("Client").cells(rows.count,"A").end(xlup)).value
If IsNumeric(Application.Match(Target.Value,montableau, 0)) Then
ligne = Application.Match(Target.Value,montableau, 0)

ensuite utiliser l’écriture des cellules avec les crochets utilise beaucoup de mémoire car tu demande a vba de faire la différence entre evaluate et une cellule en effet l’écriture "[xxx]" est une abréviation de de evaluate(xxx)
Cliquez pour agrandir...
ah bon je vais essayer cela et je vais vous répondre
merci
 
Vote positif 0 Vote négatif
patricktoulon à dit:
bonjour
commence déjà par faire un match sur ce qui est necessaire

montableau=sheets("Client").range("A1",sheets("Client").cells(rows.count,"A").end(xlup)).value
If IsNumeric(Application.Match(Target.Value,montableau, 0)) Then
ligne = Application.Match(Target.Value,montableau, 0)

ensuite utiliser l’écriture des cellules avec les crochets utilise beaucoup de mémoire car tu demande a vba de faire la différence entre evaluate et une cellule en effet l’écriture "[xxx]" est une abréviation de de evaluate(xxx)
Cliquez pour agrandir...
j'ai essayé mais je ne comprends pas comment le faire
 
Vote positif 0 Vote négatif
Je vous l'ai dit: en B16 de votre feuille de facture, propagé sur 4 colonnes et le nombre de ligne qu'il faut.
Et, rappel: pour les autre formules prendre simplement l'intersection =LCli Client!ColonneEntière mais voux pouvez aussi, si vous préférez mettre =INDEX(LCli;1;N°DeColonne)
 
Dernière édition:
Vote positif 0 Vote négatif
Dranreb à dit:
Je vous l'ai dit: en B16 de votre feuille de facture, propagé sur 4 colonnes et le nombre de ligne qu'il faut.
Et, rappel: pour les autre formules prendre simplement l'intersection =LCli Client!ColonneEntière mais voux pouvez aussi, si vous préférez mettre =INDEX(LCli;1;N°DeColonne)
Cliquez pour agrandir...
je crois que je pense bête par fois, voiçi mon fichier çi joint
 

Pièces jointes

Vote positif 0 Vote négatif
patricktoulon à dit:
bonjour
commence déjà par faire un match sur ce qui est necessaire

montableau=sheets("Client").range("A1",sheets("Client").cells(rows.count,"A").end(xlup)).value
If IsNumeric(Application.Match(Target.Value,montableau, 0)) Then
ligne = Application.Match(Target.Value,montableau, 0)

ensuite utiliser l’écriture des cellules avec les crochets utilise beaucoup de mémoire car tu demande a vba de faire la différence entre evaluate et une cellule en effet l’écriture "[xxx]" est une abréviation de de evaluate(xxx)
Cliquez pour agrandir...
Monsieur patrick ou exactement je commence à faire ce cod,j'ai envoyé un fichier joint en réponse avec Monsieur danreb
 
Vote positif 0 Vote négatif
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

D
  • Question Question
XL 2019 Aide à la compréhension d'un code VBA
Réponses
4
Affichages
991
Dudu2
Dudu2
Z
  • Question Question
Microsoft 365 code VBA envoie de mail
Réponses
2
Affichages
905
kiki29
kiki29
A
  • Question Question
Microsoft 365 VBA code pour inserer des lignes une condition
Réponses
4
Affichages
722
AEz
A
K
  • Question Question
Microsoft 365 écriture via code vba
Réponses
10
Affichages
844
soan
S
D
  • Question Question
Microsoft 365 Modification d'un code VBA
Réponses
8
Affichages
894
Hasco
Hasco
M
  • Question Question
Microsoft 365 Evolution macro - VBA - Copier/coller en fonction d'une ligne
Réponses
6
Affichages
1 K
melinavy
M
B
  • Question Question
Microsoft 365 VBA Compter 2 lignes après la fin d'un tableau dont on a le nom
Réponses
2
Affichages
881
bluesky12000
B
V
  • Question Question
XL 2016 [RESOLU] Traduction code VBA (code trouvé sur internet je ne comprend rien)
2
Réponses
17
Affichages
3 K
VBgalère
V
D
  • Résolu(e)
XL 2016 VBA Problème avec les bordures intérieures
Réponses
2
Affichages
2 K
danielco
D
J
  • Question Question
XL 2016 code vba pour envoie d'un email avec pièce jointe
Réponses
2
Affichages
2 K
jerome3131
J
S
  • Résolu(e)
Microsoft 365 Optimisation / accélération execution code VBA
Réponses
13
Affichages
2 K
spike29
S
B
  • Question Question
XL 2013 [VBA] Extraction de données basé sur 2 à 3 conditions
Réponses
2
Affichages
2 K
bastienb
B
R
  • Question Question
Microsoft 365 Insertion ligne avec code vba
Réponses
0
Affichages
977
Ricgof
R
C
  • Question Question
XL pour MAC Macro VBA suppression des données en gardant la mise en page des cellules
Réponses
2
Affichages
906
Bernard_XLD
Bernard_XLD
M
  • Question Question
Microsoft 365 Simplification de Code
Réponses
4
Affichages
1 K
MarcMad
M
N
  • Résolu(e)
XL 2016 Ne pas lancer une macro suivant info cellule
Réponses
5
Affichages
1 K
Nikoko
N
T
  • Question Question
XL 2016 Procédure trop longue
Réponses
9
Affichages
960
jmfmarques
J
K
  • Résolu(e)
Microsoft 365 Question sur VBA EXCEL
Réponses
6
Affichages
1 K
kondabalo
K
thunder23
  • Question Question
XL 2010 Alléger et rendre plus rapide un code VBA
Réponses
10
Affichages
2 K
thunder23
thunder23
J
  • Question Question
XL 2013 Macro de recopie sans copier les formules juste les valeurs et ajouter conditions
Réponses
5
Affichages
859
_Thierry
_Thierry
Retour