Comment optimiser ce code et votre expertise requise

Le 01/11/2009 à 00:00

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

3suivi.xlsm (41.06 Ko)
Le 01/11/2009 à 09:40

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+

Le 01/11/2009 à 10:05

Bonjour à tous et toutes,

Merci Galopin

Amitié

Rechercher des sujets similaires à "comment optimiser code expertise requise"