XL 2010 rendre code vba rapide

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
 

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
c'est vra ce que vous suggérez,mais c'est pour une facture en vba,comment faire pour tableau dynamique?
 

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)
 

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
 

Robert

XLDnaute Barbatruc
Repose en paix
Bonjour le fil, bonjour el forum,

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)

Merci pour cette précieuse indication que j'ignorais !... Toujours aussi bon le Patrick !
 

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.
 

Hafi.alaoui

XLDnaute Junior
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)
ah bon je vais essayer cela et je vais vous répondre
merci
 

Hafi.alaoui

XLDnaute Junior
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)
j'ai essayé mais je ne comprends pas comment le faire
 

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:

Hafi.alaoui

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

Hafi.alaoui

XLDnaute Junior
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)
Monsieur patrick ou exactement je commence à faire ce cod,j'ai envoyé un fichier joint en réponse avec Monsieur danreb
 

Discussions similaires

Réponses
10
Affichages
627
Réponses
8
Affichages
615

Statistiques des forums

Discussions
311 707
Messages
2 081 734
Membres
101 809
dernier inscrit
HADER2024