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

Signaler
Messages postés
8
Date d'inscription
mardi 21 octobre 2008
Statut
Membre
Dernière intervention
2 avril 2009
-
Messages postés
8
Date d'inscription
mardi 21 octobre 2008
Statut
Membre
Dernière intervention
2 avril 2009
-
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

5 réponses

Messages postés
1835
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
9
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+
Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
36
déplacé de VB6 vers VBA !
Messages postés
8
Date d'inscription
mardi 21 octobre 2008
Statut
Membre
Dernière intervention
2 avril 2009

C'est noté.
Dsl
Messages postés
13280
Date d'inscription
lundi 13 décembre 2004
Statut
Modérateur
Dernière intervention
3 février 2018
36
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
Messages postés
8
Date d'inscription
mardi 21 octobre 2008
Statut
Membre
Dernière intervention
2 avril 2009

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!