XL 2010 rendre code vba rapide

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...

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...

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...

Dranreb à dit:

Pour le paquet de 4 colonnes à partir de B16, vous pourriez prendre :

Code:

=INDEX(LCli;1;4*LIGNE()+COLONNE()-47)

Cliquez pour agrandir...

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...

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...