XL 2010 rendre code vba rapide

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
H

Hafi.alaoui

XLDnaute Junior
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
patricktoulon

patricktoulon

XLDnaute Barbatruc
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
Dranreb

Dranreb

XLDnaute Barbatruc
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
Robert

Robert

XLDnaute Barbatruc
Repose en paix
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
Dranreb

Dranreb

XLDnaute Barbatruc
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
H

Hafi.alaoui

XLDnaute Junior
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
H

Hafi.alaoui

XLDnaute Junior
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
Dranreb

Dranreb

XLDnaute Barbatruc
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
H

Hafi.alaoui

XLDnaute Junior
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

  • invoice.xlsm
    375.5 KB · Affichages: 5
Vote positif 0 Vote négatif
H

Hafi.alaoui

XLDnaute Junior
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

Discussions similaires

D
  • Question
XL 2019 Aide à la compréhension d'un code VBA
Réponses
4
Affichages
971
Dudu2
Dudu2
Z
  • Question
Microsoft 365 code VBA envoie de mail
Réponses
2
Affichages
897
kiki29
kiki29
A
  • Question
Microsoft 365 VBA code pour inserer des lignes une condition
Réponses
4
Affichages
714
AEz
A
K
  • Question
Microsoft 365 écriture via code vba
Réponses
10
Affichages
832
soan
S
M
  • Question
Microsoft 365 Evolution macro - VBA - Copier/coller en fonction d'une ligne
Réponses
6
Affichages
1 K
melinavy
M
D
  • Question
Microsoft 365 Modification d'un code VBA
Réponses
8
Affichages
879
Hasco
Hasco
B
  • Question
Microsoft 365 VBA Compter 2 lignes après la fin d'un tableau dont on a le nom
Réponses
2
Affichages
865
bluesky12000
B
V
  • 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
J
  • Question
XL 2016 code vba pour envoie d'un email avec pièce jointe
Réponses
2
Affichages
2 K
jerome3131
J
D
  • Résolu(e)
XL 2016 VBA Problème avec les bordures intérieures
Réponses
2
Affichages
2 K
danielco
D

Membres actuellement en ligne

12 membres et 90 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
315 088
Messages
2 116 088
Membres
112 656
dernier inscrit
VNVT