A l'aide d'un débutant en VBA: mon code fait ramer mon ordi!Résolu

Question

Bonjour à tous!

Je suis débutant en VBA et j'ai essayé de faire un code en me débrouillant comme je pouvais...
Mon code marche (ca c'est la bonne nouvelle!),mais je trouve qu'il est très lent à s'exécuter, alors je le soumets aux experts de ce site qui me montreront, j'en suis sûr, comment le simplifier!

Je vous remercie d'avance et longue vie à ce forum!

Code:

Sub recherche()



    Dim rngTrouve As Range
    Dim A As Range
    Dim B As Range
    Dim C As Range
    Dim D As Range
    Dim E As Range
    Dim F As Range
    Dim G As Range
    Dim H As Range
    Dim Y As Range
    Dim Z As Range
    Dim strChaine As String
    Dim cell As String
       
    strChaine = InputBox("Nom à rechercher :")
        
    Set rngTrouve = Worksheets("client").Columns(2).Cells.Find(what:=strChaine)
    
    If rngTrouve Is Nothing Then
        MsgBox "N'existe pas encore"
    Else
     cell = rngTrouve.Address
    End If
    
    Set Y = Sheets("client").Range("A" & rngTrouve.Row)
    Set Z = Sheets("client").Range("P" & rngTrouve.Row)
    Set A = Sheets("client").Range("Q" & rngTrouve.Row)
    Set B = Sheets("client").Range("S" & rngTrouve.Row)
    Set C = Sheets("client").Range("T" & rngTrouve.Row)
    Set D = Sheets("client").Range("V" & rngTrouve.Row)
    Set E = Sheets("client").Range("W" & rngTrouve.Row)
    Set F = Sheets("client").Range("Y" & rngTrouve.Row)
    Set G = Sheets("client").Range("Z" & rngTrouve.Row)
    Set H = Sheets("client").Range("AB" & rngTrouve.Row)
    
Sheets("client").Range(Y.Address & ":" & Z.Address).Copy
Sheets("Index").Range("C6").PasteSpecial Paste:=xlPasteValues, Transpose:=True



Sheets("client").Range(A.Address & ":" & B.Address).Copy
Sheets("Index").Range("E7").PasteSpecial Paste:=xlPasteValues



Sheets("client").Range(C.Address & ":" & D.Address).Copy
Sheets("Index").Range("E8").PasteSpecial Paste:=xlPasteValues



Sheets("client").Range(E.Address & ":" & F.Address).Copy
Sheets("Index").Range("E9").PasteSpecial Paste:=xlPasteValues



Sheets("client").Range(G.Address & ":" & H.Address).Copy
Sheets("Index").Range("E10").PasteSpecial Paste:=xlPasteValues



'je souhaite trier cette BDD par ordre croissant pour que mes fonctions rechercheV fonctionnent'



    Sheets("BDD courrier").Select
    Cells.Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Sheets("Index").Select
    Range("C6").Select



Set rngTrouve = Nothing
End Sub


Merci d'avance!
Dioul

bigfish_le vrai · Accepted Answer

Salut,

en effet les copy paste peuvent ralentir mais dans le cas present je pense plutot que cela vient de la façon dont tu utilises le find.

J'ai modifié un peu la methode du find et simplifié un peu le code. ATTENTION tout les points sont OBLIGATOIR !!! Ici ils servent à faire le lien entre la feuille et les cellules via la commande With

Sub recherche()

    Dim rngTrouve As Range
    Dim A As Range
    Dim B As Range
    Dim C As Range
    Dim strChaine As String
    Dim ligne As Long
    Application.ScreenUpdating = False
    strChaine = InputBox("Nom à rechercher :")
     
    With Sheets("client")
        Set rngTrouve = .Columns(2).Find(strChaine, , , , xlByColumns, xlPrevious, False)
        
        If rngTrouve Is Nothing Then
              Application.ScreenUpdating = True
            MsgBox "N'existe pas encore"
              Exit Sub
        Else
            ligne = rngTrouve.Row
        End If
       
        Set A = .Range("A" & ligne & ":P" & ligne)
        Set B = Union(.Range("Q" & ligne), .Range("T" & ligne), .Range("W" & ligne), .Range("Z" & ligne))
        Set C = Union(.Range("S" & ligne), .Range("V" & ligne), .Range("Y" & ligne), .Range("AB" & ligne))
    End With

    With Sheets("Index")
        A.Copy
        .Range("C6").PasteSpecial Paste:=xlPasteValues, Transpose:=True
    
        B.Copy
        .Range("E7").PasteSpecial Paste:=xlPasteValues, Transpose:=True
    
        C.Copy
        .Range("G7").PasteSpecial Paste:=xlPasteValues, Transpose:=True
    End With
  
'je souhaite trier cette BDD par ordre croissant pour que mes fonctions rechercheV fonctionnent'

    Sheets("BDD courrier").Cells.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Sheets("Index").Select
    Range("C6").Select

    Set rngTrouve = Nothing
    Application.ScreenUpdating = True
End Sub

A+

PCPT · Answer

déplacé de VB6 vers VBA !

Dioul2 · Answer

C'est noté.
Dsl

PCPT · Answer

re,
(je ne fais pas de VBA)

me semble que "copy paste" ont un effet visuel, ce qui ralenti le traitement
si c'est bien le cas, il y a une autre méthode mais je ne m'en souviens plus, voir dans l'aide (F1)

en attendant qu'un VBAiste t'oriente mieux que moi, tu peux en tout cas désactiver la sélection visuelle

çà doit être
screen.updating = false
ou 
application.screenupdate = false

à remettre à true en fin de macro

++

<hr size="2" width="100%" />
Prenez un instant pour répondre à [sujet-SONDAGE-POP3-POUR-CS_769706.aspx ce sondage] svp

Dioul2 · Answer

Merci de vos réponses!
J'ai essayé ton code Bigfish.
J'ai une erreur d'exécution 1004 (Référence de tri non valide) sur cette section:

Sheets("BDD courrier").Cells.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

Autrement le reste marche nickel!

A l'aide d'un débutant en VBA: mon code fait ramer mon ordi!

5 réponses

Votre réponse