• Initiateur de la discussion Initiateur de la discussion Alguiche
  • Date de début Date de début

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 !

A

Alguiche

Guest
Bonsoir à tous,

Ci-dessous mon code pour valider un userform. Bien qu'il y ait une soixantaine de textbox, il me semble qu'il va quand même très lentement.


Private Sub CommandButton1_Click()
Dim derlign As Range
Dim i As Byte
Dim l As Byte

Application.ScreenUpdating = False

Set derlign = Range("a65536").End(xlUp).Rows
l = TextBox63.Value

For i = 1 To l
derlign.Offset(i, 0) = derlign.Offset(i - 1, 0).Value + 1
derlign.Offset(i, 1) = Me.Controls("textbox" & i).Value
derlign.Offset(i, 2) = Me.Controls("textbox" & i + 31).Value
derlign.Offset(i, 3) = Val(Me.Controls("textbox" & i)) + Val(Me.Controls("textbox" & i + 31))
derlign.Offset(i, 4) = (Val(Me.Controls("textbox" & i)) + Val(Me.Controls("textbox" & i + 31))) * 160
Next i

Application.ScreenUpdating = True

End Sub

Quelqu'un a-t-il une suggestion pour l'améliorer?

Merci d'avance
A+
Al
 
Re : Code très lent

Salut Alguiche

Pour sauver la selection de derlign à toutes les fois With...End With

Private Sub CommandButton1_Click()
Dim derlign As Range
Dim i As Byte
Dim l As Byte

Application.ScreenUpdating = False

Set derlign = Range("a65536").End(xlUp).Rows
l = TextBox63.Value

With derlign

For i = 1 To l
.Offset(i, 0) = derlign.Offset(i - 1, 0).Value + 1
.Offset(i, 1) = Me.Controls("textbox" & i).Value
.Offset(i, 2) = Me.Controls("textbox" & i + 31).Value
.Offset(i, 3) = Val(Me.Controls("textbox" & i)) + Val(Me.Controls("textbox" & i + 31))
.Offset(i, 4) = (Val(Me.Controls("textbox" & i)) + Val(Me.Controls("textbox" & i + 31))) * 160
Next i

End With

Application.ScreenUpdating = True

End Sub

Sinon en passant par des modules de Class ?
N'ayant pas le fichier sous la main pour tester 🙁

Mytå
 
Re : Code très lent

Bonsoir Alguiche, bonsoir Mytå,
bonsoir à toutes et à tous 🙂

Alguiche, tu peux également essayer de désactiver le calcul automatique et passer par un tableau :

Code:
Option Explicit
Private Sub CommandButton1_Click()
'
'----------------------------
Dim DerLign        As Range
'----------------------------
Dim Cel            As Range
'----------------------------
Dim i              As Byte
Dim l              As Byte
'----------------------------
Dim OldCalculation As Long
'----------------------------
Dim Tableau()      As Variant
'----------------------------
'
  With Application
    OldCalculation = .Calculation
    .Calculation = xlCalculationManual
    .ScreenUpdating = True
  End With
 
  Set DerLign = Sheets("Database").Range("a65536").End(xlUp)
 
  If TextBox63 = "" Then
    MsgBox ("Il faut indiquer le nb de jours")
    Exit Sub
  End If
 
  l = TextBox63.Value
  ReDim Tableau(1 To l, 1 To 5)
 
  With Me
    For i = 1 To l
      If i = 1 Then
        Tableau(i, 1) = DerLign + 1
      Else
        Tableau(i, 1) = Tableau(i - 1, 1) + 1
      End If
      Tableau(i, 2) = CDbl(.Controls("TextBox" & i))
      Tableau(i, 3) = CDbl(.Controls("TextBox" & i + 31))
      Tableau(i, 4) = Tableau(i, 2) + Tableau(i, 3)
      Tableau(i, 5) = Tableau(i, 4) * 160#
    Next i
  End With
 
  DerLign.Offset(1, 0).Resize(UBound(Tableau, 1), UBound(Tableau, 2)) = Tableau
 
  With Sheets("Recap")
    On Error Resume Next
    Set Cel = .Range("E:E").Find(Tableau(1, 1), .Range("E1"), xlFormulas, _
                 xlWhole, xlByColumns, xlNext, False).EntireRow.Calculate
    If Err <> 0 Then
      Err.Clear
    Else
      Call MajGraph.MajGraph
    End If
  End With
  On Error GoTo 0
 
  With Application
    .Calculation = OldCalculation
    .ScreenUpdating = True
  End With
End Sub

Tiens-nous au courant...

A+ 😉
 
Re : Code très lent

Salut Charly2,

Alors là je suis soufflé, pour aller plus vite ça va plus vite. Je vais étudier ton code car je ne connaissais pas cette méthode et pour dire vrai tout ce qui concerne les tableaux mais encore bien obscure.

Merci beaucoup pour ton aide et au plaisir
Al
 
- 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
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

Réponses
5
Affichages
914
Réponses
3
Affichages
923
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
1 K
Retour