Comment optimiser ce code et votre expertise requise
A
Bonsoir The forum,
Comment optimiser le code ci--dessous, j ai besoin de votre expertise pour que je sois tranquilisé sur la viabilité de ce code.
Toutes les variables ont été déclarées, les noms (C1,C2,etc...) sont les noms de mes textboxes.
Private Sub UserForm_Activate()
Dim TROUVE1 As Variant
Dim e As Range
Dim f As Range
Dim g As Range
C1 = Worksheets("Restitution Douchette").Range("T65536").End(xlUp).Offset(1, -19)
C3 = Worksheets("Restitution Douchette").Range("T65536").End(xlUp).Offset(1, -18)
C4 = Mid(C1, 5, 2) & "/" & Mid(C1, 3, 2) & "/" & Mid(C1, 1, 2)
C20 = Date
C21 = Format(Time, "HH:MM:SS")
C23 = WorksheetFunction.Sum((WorksheetFunction.Max(Sheets("Journal evenements").Range("t:t"))) + 1)
C24 = Range("userB").Value
C25 = CDec(Mid(C1, 13, 6))
TROUVE1 = CDec(C25)
Set c = Worksheets("BASE A").Columns("W:W").Find(What:=CDec(C25), LookIn:=xlValues, LookAt:=xlPart)
If c Is Nothing Then
'Je récupère les informations disponible dans la feuille de modification
Set d = Worksheets("Restitution Douchette").Range("T65536").End(xlUp).Offset(1, 0)
i = d.Row
C6 = Cells(i, 6)
C8 = Cells(i, 8)
C9 = Cells(i, 9)
C10 = Cells(i, 10)
C11 = Cells(i, 11)
C12 = Cells(i, 12)
C13 = Cells(i, 13)
C14 = Cells(i, 14)
C15 = Cells(i, 15)
C16 = Cells(i, 16)
C17 = Cells(i, 17)
C18 = Cells(i, 18)
C19 = Cells(i, 19)
C22 = "Acquisition"
i = ""
Else
'Je récupère les informations disponible dans la base de donnée
Set f = Worksheets("BASE A").Columns("W:W").Find(What:=CDec(C25), LookIn:=xlValues, LookAt:=xlPart)
If Not f Is Nothing Then
Worksheets("BASE A").Select
i = f.Row
C4 = Cells(i, 2).Value
C5 = Cells(i, 3).Value
C6 = Cells(i, 4).Value
If Not Me.C1 <> "" Then C7 = Cells(i, 5).Value
C8 = Cells(i, 6).Value
C9 = Cells(i, 7).Value
C10 = Cells(i, 8).Value
C11 = Cells(i, 9).Value
C12 = Cells(i, 10).Value
C13 = Cells(i, 11).Value
C14 = Cells(i, 12).Value
C15 = Cells(i, 13).Value
C16 = Cells(i, 14).Value
C17 = Cells(i, 15).Value
C18 = Cells(i, 16).Value
C19 = Cells(i, 17).Value
C22 = "Modification"
i = ""
'J'écrase les informations récupérées dans la BD si elles ont été modifiées dans la feuille de modification
Set g = Worksheets("Restitution Douchette").Range("T65536").End(xlUp).Offset(1, 0)
i = g.Row
Worksheets("Restitution Douchette").Select
If Cells(i, 4) <> "" Then Me.C4 = Cells(i, 4).Value
If Cells(i, 5) <> "" Then Me.C5 = Cells(i, 5).Value
If Cells(i, 6) <> "" Then Me.C6 = Cells(i, 6).Value
If Cells(i, 8) <> "" Then Me.C8 = Cells(i, 8).Value
If Cells(i, 9) <> "" Then Me.C9 = Cells(i, 9).Value
If Cells(i, 10) <> "" Then Me.C10 = Cells(i, 10).Value
If Cells(i, 11) <> "" Then Me.C11 = Cells(i, 11).Value
If Cells(i, 12) <> "" Then Me.C12 = Cells(i, 12).Value
If Cells(i, 13) <> "" Then Me.C13 = Cells(i, 13).Value
If Cells(i, 14) <> "" Then Me.C14 = Cells(i, 14).Value
If Cells(i, 15) <> "" Then Me.C15 = Cells(i, 15).Value
If Cells(i, 16) <> "" Then Me.C16 = Cells(i, 16).Value
If Cells(i, 17) <> "" Then Me.C17 = Cells(i, 17).Value
If Cells(i, 18) <> "" Then Me.C18 = Cells(i, 18).Value
If Cells(i, 19) <> "" Then Me.C19 = Cells(i, 19).Value
End If
End If
End Sub
Merci à vous tous
Amitié
Air_2
bonjour,
validité et viabilité ça doit le faire...
Optimisation... tu peux essayer ça (suppression des select et des offset) :
Private Sub UserForm_Activate()
Dim TROUVE1 As Variant
Dim c As Range
Dim f As Range
Dim i!, k!
With Worksheets("Restitution Douchette")
i = .Range("T65536").End(xlUp).Row + 1
C1 = .Cells(i, 1)
C3 = .Cells(i, 2)
End With
C4 = Mid(C1, 5, 2) & "/" & Mid(C1, 3, 2) & "/" & Mid(C1, 1, 2)
C20 = Date
C21 = Format(Time, "HH:MM:SS")
C23 = WorksheetFunction.Sum((WorksheetFunction.Max(Sheets("Journal evenements").Range("t:t"))) + 1)
C24 = Range("userB")
C25 = CDec(Mid(C1, 13, 6))
TROUVE1 = CDec(C25)
Set c = Worksheets("BASE A").Columns("W:W").Find(What:=CDec(C25), LookIn:=xlValues, LookAt:=xlPart)
If c Is Nothing Then
With Worksheets("Restitution Douchette")
'Je récupère les informations disponible dans la feuille de modification
C6 = .Cells(i, 6)
C8 = .Cells(i, 8)
C9 = .Cells(i, 9)
C10 = .Cells(i, 10)
C11 = .Cells(i, 11)
C12 = .Cells(i, 12)
C13 = .Cells(i, 13)
C14 = .Cells(i, 14)
C15 = .Cells(i, 15)
C16 = .Cells(i, 16)
C17 = .Cells(i, 17)
C18 = .Cells(i, 18)
C19 = .Cells(i, 19)
C22 = "Acquisition"
End With
Else
'Je récupère les informations disponible dans la base de donnée
Set f = Worksheets("BASE A").Columns("W:W").Find(What:=CDec(C25), LookIn:=xlValues, LookAt:=xlPart)
If Not f Is Nothing Then
With Worksheets("BASE A")
k = f.Row
C4 = .Cells(k, 2)
C5 = .Cells(k, 3)
C6 = .Cells(k, 4)
If Not C1 <> "" Then C7 = .Cells(k, 5)
C8 = .Cells(k, 6)
C9 = .Cells(k, 7)
C10 = .Cells(k, 8)
C11 = .Cells(k, 9)
C12 = .Cells(k, 10)
C13 = .Cells(k, 11)
C14 = .Cells(k, 12)
C15 = .Cells(k, 13)
C16 = .Cells(k, 14)
C17 = .Cells(k, 15)
C18 = .Cells(k, 16)
C19 = .Cells(k, 17)
C22 = "Modification"
End With
'J'écrase les informations récupérées dans la BD si elles ont été modifiées dans la feuille de modification
With Worksheets("Restitution Douchette")
If .Cells(i, 4) <> "" Then C4 = .Cells(i, 4)
If .Cells(i, 5) <> "" Then C5 = .Cells(i, 5)
If .Cells(i, 6) <> "" Then C6 = .Cells(i, 6)
If .Cells(i, 8) <> "" Then C8 = .Cells(i, 8)
If .Cells(i, 9) <> "" Then C9 = .Cells(i, 9)
If .Cells(i, 10) <> "" Then C10 = .Cells(i, 10)
If .Cells(i, 11) <> "" Then C11 = .Cells(i, 11)
If .Cells(i, 12) <> "" Then C12 = .Cells(i, 12)
If .Cells(i, 13) <> "" Then C13 = .Cells(i, 13)
If .Cells(i, 14) <> "" Then C14 = .Cells(i, 14)
If .Cells(i, 15) <> "" Then C15 = .Cells(i, 15)
If .Cells(i, 16) <> "" Then C16 = .Cells(i, 16)
If .Cells(i, 17) <> "" Then C17 = .Cells(i, 17)
If .Cells(i, 18) <> "" Then C18 = .Cells(i, 18)
If .Cells(i, 19) <> "" Then C19 = .Cells(i, 19)
End With
End If
End If
End Sub
A+
A
Bonjour à tous et toutes,
Merci Galopin
Amitié