VBA faire une RECHERCHEV sur un grand nombre de cellule d'une même colonne

Le 27/08/2020 à 10:22

Bonjour à tous,

Je débute en VBA et j'ai besoin de votre aide. J'ai un fichier composant de 3 feuilles: Devis, Base, Prix négocié.

La feuille "Base" comporte tout les cas de figures "d'ensemble de produit" avec leur prix de revient. Elle est en interaction avec la feuille "Prix négocié" dans le cas où nous devons changer le prix du bois ou du miroir dans un ensemble de produit.

Bien sur, ces deux feuilles sont en lien avec le feuille "Devis". Le lien se fait au niveau du prix de revient et de sa décomposition.

Aujourd'hui, j'aimerais mettre à jour tout les prix dans le cas où on renégocierait le prix du bois ou du miroir, à l'aide du bouton "Mettre à jour le prix de revient".

J'ai déjà trouvé une programmation pour la première ligne (ligne 5):

Sub Bouton9_Cliquer()
If Range("A5") = "" Then
Range("H5") = ""
Else
Range("H5") = Application.VLookup(Range("A5"), Sheets("Base").Range("A7:L17"), 7, False)
Range("K5") = Application.VLookup(Range("A5"), Sheets("Base").Range("A7:L17"), 8, False)
Range("L5") = Application.VLookup(Range("A5"), Sheets("Base").Range("A7:L17"), 9, False)
Range("M5") = Application.VLookup(Range("A5"), Sheets("Base").Range("A7:L17"), 10, False)
Range("N5") = Application.VLookup(Range("A5"), Sheets("Base").Range("A7:L17"), 11, False)
Range("O5") = Application.VLookup(Range("A5"), Sheets("Base").Range("A7:L17"), 12, False)
End If
End Sub

Cependant, il se peut que nous ajoutions un certain nombre de ligne dans le devis et le code risque de se démultiplier. Et je ne me vois pas faire le même code pour 1000 lignes.

Avez-vous une solution à me proposer? J'ai pensé à faire un code "Boucle".

Merci d'avance

32test-forum.xlsm (45.22 Ko)
Le 27/08/2020 à 10:48

Bonjour paulo78670,

Voici le fichier en retour pour tester :

120test-forum-paulo78670.xlsm (44.83 Ko)
Le 27/08/2020 à 11:51

Merci IronBoule,

C'est exactement ce que je voulais.

Le 31/08/2020 à 15:22

Bonjour IronBoule,

J'ai adapté ton codage sur mon fichier d'origine avec ton code suivant

Sub update_price()
    lastline_devis = Range("A" & Rows.Count).End(xlUp).Row
    lastline_base = Sheets("Base").Range("A" & Rows.Count).End(xlUp).Row

    For i = 5 To lastline_devis
        line_cas = Cells(i, 1).Value
            For j = 7 To lastline_base
                If Cells(i, 1) = "" Then
                    Cells(i, 8) = ""
                Else
                    If line_cas = Sheets("Base").Cells(j, 1) Then
                        Cells(i, 8) = Sheets("Base").Cells(j, 7)
                        Cells(i, 11) = Sheets("Base").Cells(j, 8)
                        Cells(i, 12) = Sheets("Base").Cells(j, 9)
                        Cells(i, 13) = Sheets("Base").Cells(j, 10)
                        Cells(i, 14) = Sheets("Base").Cells(j, 11)
                        Cells(i, 15) = Sheets("Base").Cells(j, 12)
                    End If
                End If
            Next j
        Next i
End Sub

Sauf que dès que j'appuis sur "mettre à jour le prix de revient", les prix mettent un certain temps à se mettre à jour.

J'aimerais faire un gain de temps pour la mise à jour, est-il possible de lui dire, dans le code, de commencer à la dernière cellule de la colonne A rempli ou de lui dire de commencer à telle cellule de chaque feuille?

Au lieu de lui dire de commencer à la dernière ligne de la feuille Base et la dernière ligne de la feuille devis.

Le 02/09/2020 à 08:26

Bonjour Paulo,

Au tout début du code, ajoute

Application.ScreenUpdating = False

Ce qui va permettre de figer l'écran et d'accélérer u peu le processus.

Vois déjà avec ça et dis moi si cela convient.

Le 02/09/2020 à 08:50

Bonjour IronBoule,

Alors, voici le code initiale que j'ai adapté à mon fichier:

Sub Bouton9_Cliquer()
    lastline_estimation = Range("A1000").End(xlUp).Row
    lastline_base = Sheets("Base").Range("A1000").End(xlUp).Row

    For i = 21 To lastline_estimation
        line_cas = Cells(i, 1).Value
            For j = 10 To lastline_base
                If Cells(i, 1) = "" Then
                    Cells(i, 15) = ""
                Else
                    If line_cas = Sheets("Base").Cells(j, 1) Then
                        Cells(i, 15) = Sheets("Base").Cells(j, 10)
                        Cells(i, 20) = Sheets("Base").Cells(j, 13)
                        Cells(i, 22) = Sheets("Base").Cells(j, 14)
                        Cells(i, 24) = Sheets("Base").Cells(j, 15)
                        Cells(i, 26) = Sheets("Base").Cells(j, 16)
                        Cells(i, 28) = Sheets("Base").Cells(j, 17)
                        Cells(i, 30) = Sheets("Base").Cells(j, 18)
                        Cells(i, 32) = Sheets("Base").Cells(j, 19)
                        Cells(i, 34) = Sheets("Base").Cells(j, 20)
                        Cells(i, 36) = Sheets("Base").Cells(j, 21)
                        Cells(i, 38) = "X"
                    End If
                End If
            Next j
        Next i
End Sub

Je lui ai demandé de commencer à la cellule A1000 de chaque feuille et la mise à jour met exactement 2,41 min avant que je puisse faire autre chose sur le fichier.

Quand j'ai intégré ton code:

Sub Bouton9_Cliquer()
Application.ScreenUpdating = False
    lastline_estimation = Range("A1000").End(xlUp).Row
    lastline_base = Sheets("Base").Range("A1000").End(xlUp).Row

    For i = 21 To lastline_estimation
        line_cas = Cells(i, 1).Value
            For j = 10 To lastline_base
                If Cells(i, 1) = "" Then
                    Cells(i, 15) = ""
                Else
                    If line_cas = Sheets("Base").Cells(j, 1) Then
                        Cells(i, 15) = Sheets("Base").Cells(j, 10)
                        Cells(i, 20) = Sheets("Base").Cells(j, 13)
                        Cells(i, 22) = Sheets("Base").Cells(j, 14)
                        Cells(i, 24) = Sheets("Base").Cells(j, 15)
                        Cells(i, 26) = Sheets("Base").Cells(j, 16)
                        Cells(i, 28) = Sheets("Base").Cells(j, 17)
                        Cells(i, 30) = Sheets("Base").Cells(j, 18)
                        Cells(i, 32) = Sheets("Base").Cells(j, 19)
                        Cells(i, 34) = Sheets("Base").Cells(j, 20)
                        Cells(i, 36) = Sheets("Base").Cells(j, 21)
                        Cells(i, 38) = "X"
                    End If
                End If
            Next j
        Next i
End Sub

Je mets 1,06 min, c'est mieux mais connaissant ceux qui vont l'utiliser cela sera trop long.

As-tu une autre solution?

Merci d'avance.

Paulo

Le 02/09/2020 à 09:44

Je vais regarder dans la journée voir si je trouve quelque chose, mais bon, je sais qu'1 minute ça peut faire beaucoup à attendre, mais pour mettre à jour presque 1000 références, ça va encore :)

Je te tiens informé dans la journée !

Le 02/09/2020 à 09:55

Merci IronBoule.

Pour info, il y aura à peu prés 800 ligne, sachant que les utilisateur pourront rajouter des ligne dans la feuille à mettre à jour et je suppose que le temps se multipliera.

Dans l'attente de ton retour, merci encore.

Paulo

Le 02/09/2020 à 13:02

Re,

Sinon, sans passer par du VBA, mais avec des formules (bien sûr, en protégeant les cellules concernées pour éviter de "casser" le fichier) :

29test-forum-paulo78670.xlsm (45.94 Ko)

Pour tester, dans la colonne A tu ajoute ou enlève un nombre "cas" et les lignes se mettent à jour automatiquement grâce aux formules et à l'onglet "Base".

Le fichier se met à jour à l'instant T et à chaque ajout de lignes. Et si tu dois modifier les valeurs de l'onglet "base", le tableau se met à jour aussi.

Le 02/09/2020 à 13:27

Re,

Je connais cette solution mais le problème est que avant de mettre à jour les prix de revient les utilisateur utilise un Userbox pour faire leur choix et des que le choix est fait. Le prix de revient d’intégré dans la cellule concerné. Du coup la formule s’efface.

Merci tout de même

Le 02/09/2020 à 14:12

Mais cela revient au même avec le système mit en place en VBA non !?

L'utilisateur va ajouter dans le UserForm la valeur voulue qui va donc se mettre dans la cellule concernée, mais cette valeur, ne faisant pas partie de l'onglet "base", sera supprimée dès que tu cliqueras sur "Mettre à jour", puisque les colonnes se remplissent avec les valeurs de l'onglet "base" seulement en fonction du N° de cas.

Le 02/09/2020 à 14:51

Pour être plus clair, le fichier s'ouvre et l'Userform ci-dessous s’exécute:

userform

L'utilisateur choisi son produit, le "Prix de revient" se mettra dans la cellule concerné.

Quelques temps plus tard, l'utilisateur veux agir sur le "Prix de revient" pour gratter un peu, il va donc aller dans la feuille BDD pour modifier le prix de matière première.

Ensuite il appuiera sur "mettre à jour" pour que le "Prix de revient" soit modifié.

Je pense que cette explication est plus précise IronBoule non !?

Le 02/09/2020 à 15:13

Oui, la je comprends mieux le principe de l'onglet "base" et de la mise à jour des données.

Par contre, je ne vois pas comment rendre la procédure + rapide... J'ai essayé en ajoutant une condition mais on ne gagne presque rien.

Après, en faisant les tests, la durée du script est à peu prés de 1 minute, quand aucune données n'est saisies. Une fois que toutes les données sont saisies et que l'on vient à modifier l'onglet "base" puis mettre à jour, la durée (après 3-4 tests) n'est que de 6-7 secondes.

Le 02/09/2020 à 15:37

Quand on prend le temps de bien expliquer c'est toujours mieux

Après ta réponse, je reste sur le code que tu m'as conseillé

Application.ScreenUpdating = False

Ce qui donnerait dans le code complet:

Sub Bouton9_Cliquer()
Application.ScreenUpdating = False
    lastline_estimation = Range("A1000").End(xlUp).Row
    lastline_base = Sheets("Base").Range("A1000").End(xlUp).Row

    For i = 21 To lastline_estimation
        line_cas = Cells(i, 1).Value
            For j = 10 To lastline_base
                If Cells(i, 1) = "" Then
                    Cells(i, 15) = ""
                Else
                    If line_cas = Sheets("Base").Cells(j, 1) Then
                        Cells(i, 15) = Sheets("Base").Cells(j, 10)
                        Cells(i, 20) = Sheets("Base").Cells(j, 13)
                        Cells(i, 22) = Sheets("Base").Cells(j, 14)
                        Cells(i, 24) = Sheets("Base").Cells(j, 15)
                        Cells(i, 26) = Sheets("Base").Cells(j, 16)
                        Cells(i, 28) = Sheets("Base").Cells(j, 17)
                        Cells(i, 30) = Sheets("Base").Cells(j, 18)
                        Cells(i, 32) = Sheets("Base").Cells(j, 19)
                        Cells(i, 34) = Sheets("Base").Cells(j, 20)
                        Cells(i, 36) = Sheets("Base").Cells(j, 21)
                        Cells(i, 38) = "X"
                    End If
                End If
            Next j
        Next i
End Sub

Peux-tu me confirmer?

Pour le temps, je suis septique que sur mon fichier j'en ai pour 6-7 secondes, car les utilisateur vont insérer beaucoup de ligne pour décrire un maximum de produit et le code va prendre beaucoup de temps à rechercher les "Cas" pour les mettre à jour.......

Le 02/09/2020 à 15:41

Oui, c'est bien ça !

Ca peut être un peu plus long, mais le plus long c'est de remplir les données manquantes, une fois que toutes les données sont saisies, ce ne sera que du cas par cas donc plus rapide .

J'ai fait plusieurs essai avec un tableau de 1 100 lignes (je me suis amusé !) et la mise à jour ne m'a pris que 6-7 secondes.

Le 02/09/2020 à 15:48

Bonjour tout le monde !

Si le fichier contient aussi des formules diverses, l'ajout des instructions ci dessous fera gagner beaucoup de temps :

Application.Calculation = xlCalculationManual 'en début de macro
'Reste du code...
Application.Calculation = xlCalculationAutomatic 'en fin de macro
Le 02/09/2020 à 16:09

Merci Pedro et IronBoule !!!!!

La MAJ des "prix de revient marche du feu de dieu (- de 5s).

Bonne continuation à vous deux

Ps: J'ai un autre sujet où personne ne m'a répondu. Si vous pouvez m'aider.....

Rechercher des sujets similaires à "vba recherchev grand nombre meme colonne"