Optimisation : comme une rechercheV

Version imprimable

Voir 40 message(s) de cette discussion en une page

Bonjour, cela fait un certain temps que je programme en VBA mais je reste sur une question que je me pose fréquemment.

En effet, je reprogramme régulièrement en vba le code qui permet de faire comme une rechercheV.

Comment puis je l'optimiser? Y a t il une fonction déjà faites? Je fais appelle à vos connaissances.

Je vous mets mon codes :

Code:

1
2
3
4
5
Sub part_descr()
 
    remplissage "Enveloppe_NPT", 4, "NPT_Analyse", 3
 
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub remplissage(nom_feuille_origine, num_colonne_origine, nom_feuille_destination, num_colonne_destination)
 
Dim compteur1, compteur2, max1, max2 As Integer
Dim ref1, ref2 As String
 
 
max1 = max_ligne(nom_feuille_origine, 1)
max2 = max_ligne(nom_feuille_destination, 1)
 
For compteur2 = 2 To max2
     ref2 = Sheets(nom_feuille_destination).Cells(compteur2, 1).Value
     For compteur1 = 2 To max1
        ref1 = Sheets(nom_feuille_origine).Cells(compteur1, 1).Value
        If ref1 = ref2 Then
           Sheets(nom_feuille_destination).Cells(compteur1, num_colonne_destination).Value = Sheets(nom_feuille_origine).Cells(compteur1, num_colonne_origine).Value
           Exit For
        End If
     Next
Next
 
End Sub

Code:

1
2
3
4
5
Function max_ligne(nom_feuille, num_colonne)
 
max_ligne = Sheets(nom_feuille).Cells(Rows.Count, num_colonne).End(xlUp).Row
 
End Function

Merci d'avance pour vos réponses.

Vincent

J'ai trouvé cela, mais ça ne marche pas :-( ==> "Erreur définie par l'application ou par l'objet"

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub remplissage(nom_feuille_origine, num_colonne_origine, nom_feuille_destination, num_colonne_destination)
 
Dim compteur1, compteur2, max1, max2, max_col As Integer
Dim ref1, ref2 As String
 
 
max1 = max_ligne(nom_feuille_origine, 1)
max2 = max_ligne(nom_feuille_destination, 1)
 
max_col = max_colonne(nom_feuille_origine, 2)
 
For compteur2 = 3 To max2
 Sheets(nom_feuille_destination).Range(Cells(compteur2, num_colonne_destination)).Value = Application.VLookup(Sheets(nom_feuille_destination).Range(Cells(compteur2, 1)).Value, Sheets(nom_feuille_origine).Range(Cells(1, 1), Cells(max1, max_col)), num_colonne_origine, False)
Next
 
End Sub

23/11/2018, 12h06
mfoxy

Hello

Peut-être utiliser la méthode find dans Vba ?

Exemple :

https://www.developpez.net/forums/d1...tion-find-vba/

Méthode site Microsoft

https://docs.microsoft.com/en-us/off...cel.range.find
23/11/2018, 12h11
guismoman60

Oula tu viens contrecarré mes plans là lol

Je n'arrive pas à comprendre comment je peux faire avec le FIND.

Vincent
23/11/2018, 12h45
MarcelG

Bonjour à vous,

mfoxy,

J'ai activé ton lien.
Il me retourne un texte en anglais.

Le voici en Français

Méthode Find Français

Guismoman,

Un exemple est donné.
Tu peux adapter celui-ci pour chaque cellule à tester donc par une boucle
23/11/2018, 13h33
guismoman60

Et vous avez pas la solution en prenant la rechercheV direct dans le VBA?

je doute qu'une boucle avec un find soit efficace et plus optimiser que mon code actuel.
23/11/2018, 13h38
MarcelG

Salut,

Citation:

Et vous avez pas la solution en prenant la rechercheV direct dans le VBA?

Non.

Citation:

je doute qu'une boucle avec un find soit efficace et plus optimiser que mon code actuel.

D'accord.
Tu peux donc passer cette discussion en mode "Résolue"
23/11/2018, 13h41
guismoman60

Je n'arrive pas à transformer mon code avec un find.

De plus, mon code bug sur cette ligne

Code:

Sheets(nom_feuille_destination).Cells(compteur2, num_colonne_destination).Value = Application.VLookup(Sheets(nom_feuille_destination).Cells(compteur2, 1).Value, Sheets(nom_feuille_origine).Range(Cells(1, 1), Cells(max1, max_col)), num_colonne_origine, False)

et je ne comprends pas pourquoi.

Autant pour moi, j'ai réussi à faire ceci :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub remplissage(nom_feuille_origine, num_colonne_origine, nom_feuille_destination, num_colonne_destination)
 
Dim compteur1, compteur2, max1, max2, max_col As Integer
Dim ref1, ref2 As String
Dim range1 As Integer
 
 
max1 = max_ligne(nom_feuille_origine, 1)
max2 = max_ligne(nom_feuille_destination, 1)
 
max_col = max_colonne(nom_feuille_origine, 2)
 
'For compteur2 = 3 To max2
' Sheets(nom_feuille_destination).Cells(compteur2, num_colonne_destination).Value = Application.VLookup(Sheets(nom_feuille_destination).Cells(compteur2, 1).Value, Sheets(nom_feuille_origine).Range(Cells(1, 1), Cells(max1, max_col)), num_colonne_origine, False)
'Next
 
 
For compteur2 = 3 To max2
 ref1 = Sheets(nom_feuille_destination).Cells(compteur2, 1).Value
 range1 = Sheets(nom_feuille_origine).Columns(1).Find(ref1).Row
 Sheets(nom_feuille_destination).Cells(compteur2, num_colonne_destination).Value = Sheets(nom_feuille_origine).Cells(range1, num_colonne_origine).Value
Next
 
 
End Sub

Ca marche, le temps est beaucoup plus réduit. Si quelqu'un à la solution Vlookup pour pouvoir tester la différence.

Merci beaucoup pour vos conseils ;-)

Pour ton recherche , vlookup je ne t aiderai pas car c est pas ma façon de coder
Cependant pour augmenter encore la vitesse de ta macro
Tu peu placer ces lignes dans ton code pour encadrer
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Sub xxx () 'tes variables Application.ScreenUpdating = False Application.Calculation = xlCalculationManual ' ton code de traitement boucle,.. Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic

je viens de m'apercevoir d'une erreur.

En effet, lorsque mon FIND ne trouve pas la référence ref1, il m'indique le message d'erreur suivant :

- Variable objet ou variable de bloc With non définie.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 Sub remplissage(nom_feuille_origine, num_colonne_origine, nom_feuille_destination, num_colonne_destination) Dim compteur1, compteur2, max1, max2, max_col As Integer Dim ref1, ref2 As String Dim range1 As Variant max1 = max_ligne(nom_feuille_origine, 1) max2 = max_ligne(nom_feuille_destination, 1) max_col = max_colonne(nom_feuille_origine, 2) For compteur2 = 3 To max2 ref1 = Sheets(nom_feuille_destination).Cells(compteur2, 1).Value range1 = Sheets(nom_feuille_origine).Columns(1).Find(ref1).Row Next End Sub
Il bloque sur le

Code:

range1 = Sheets(nom_feuille_origine).Columns(1).Find(ref1).Row

23/11/2018, 15h17
Ecthelion2

Bonjour,

si le but est de répliquer le fonctionnement exact d'une rechercheV, pourquoi s'embêter à recoder la fonction avec une boucle, ou à utiliser un find, alors qu'il suffit d'utiliser la fonction rechercheV elle-même directement en VBA (même si le find peut avoir divers avantages en plus) ?

Application.WorksheetFunction.VLookup()

Voir le lien ci-dessous pour le nombre et la signification des arguments à transmettre dans l'appel (peu ou prou les mêmes qu'en utilisant la formule d'ailleurs).

https://docs.microsoft.com/fr-fr/off...6)%26rd%3Dtrue

Si cela ne "marche pas" comme indiqué dans votre 2ème message, c'est qu'il y a un problème au niveau des arguments transmis, mais la fonction elle-même fonctionne très bien.
23/11/2018, 15h18
MarcelG

Salut,

Normal.
Le code ne peut pas retourner la propriété Row d'un objet Range qui n'est rien.
Voir l'aide Microsoft.
Conditionner cette propriété à l'existence de l'objet Range trouvé.

C'est ce que je demandais au début de la conversation.

comme ceci, mais ca ne marche pas :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Dim ref1, ref2 As String
 
 
max1 = max_ligne(nom_feuille_origine, 1)
max2 = max_ligne(nom_feuille_destination, 1)
 
max_col = max_colonne(nom_feuille_origine, 2)
 
For compteur2 = 3 To max2
 Sheets(nom_feuille_destination).Range(Cells(compteur2, num_colonne_destination)).Value = Application.VLookup(Sheets(nom_feuille_destination).Range(Cells(compteur2, 1)).Value, Sheets(nom_feuille_origine).Range(Cells(1, 1), Cells(max1, max_col)), num_colonne_origine, False)
Next
 
End Sub

Tu peux me dire ce qui fonctionne pas ? une idée?

Merci beaucoup pour ton aide

Vincent

MarcelG j'ai toujours la même erreur

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Sub remplissage(nom_feuille_origine, num_colonne_origine, nom_feuille_destination, num_colonne_destination)
 
Dim compteur1, compteur2, max1, max2, max_col As Integer
Dim ref1, ref2 As String
Dim range1 As Range
Dim range2 As Integer
 
 
max1 = max_ligne(nom_feuille_origine, 1)
max2 = max_ligne(nom_feuille_destination, 1)
 
max_col = max_colonne(nom_feuille_origine, 2)
 
 
 
 
For compteur2 = 3 To max2
 ref1 = Sheets(nom_feuille_destination).Cells(compteur2, 1).Value
 range1 = Sheets(nom_feuille_origine).Columns(1).Find(ref1)
 If range1 Is Nothing Then
    Sheets(nom_feuille_destination).Cells(compteur2, num_colonne_destination).Value = "Pas trouvé"
 Else
    range2 = range1.Row
    Sheets(nom_feuille_destination).Cells(compteur2, num_colonne_destination).Value = Sheets(nom_feuille_origine).Cells(range2, num_colonne_origine).Value
 End If
 
Next
 
 
End Sub

Code:

range1 = Sheets(nom_feuille_origine).Columns(1).Find(ref1)

Dès qu'il ne trouve pas la valeur, le message d'erreur intervient.

23/11/2018, 15h34
Ecthelion2

Citation:

Envoyé par guismoman60

Tu peux me dire ce qui fonctionne pas ? une idée?

Difficile sans le fichier concerné pour tester, je n'ai déjà aucun moyen de savoir que les valeurs présentes dans vos variables sont "justes".

- Déjà dans un premier temps, est-ce que cela bloque dès la première itération ou certaines recherches se font et cela bloque à la X ème ligne ?

Si cela bloque dès le début, probablement quelque chose qui ne va pas au niveau des arguments transmis. Le mieux, c'est de faire des essais dans un fichier test, vous prenez votre bout de code, et au lieu de ne mettre que des variables directement, ce qui vous serre normalement à faire votre traitement dans votre boucle, vous mettez les valeurs des variables en dur, pour voir si déjà sur une ligne, cela fonctionne.

Et si c'est le cas, vous laissez les valeurs en dur pour 3 arguments sur 4, et vous remettez la 4ème variable en place et idem après chaque essai jusqu'à trouver l'argument qui ne vas pas (il n'y a que 4 arguments, c'est vite fait).

- Si le traitement se fait sur les premières lignes mais bloque ligne Y, c'est peut-être que l'élément recherché n'est pas présent dans le tableau cible, il faut donc prévoir une gestion d'erreur.

- Après voir aussi, lorsque vous faites évoluer vos variables, si elles ne prennent pas des valeurs qui ne vont pas.
23/11/2018, 15h36
guismoman60

Ecthelion2 avec l'option VLookup mon programme bloque dès la premiere itération . Il ne veut pas passer la ligne sans erreur. J'ai vérifié les variables, et elles sont toutes bien déclarée et récupère bien les valeurs.

Je pense que c'est une erreur de synthaxe dans la fonction VLookUp.

voici en dure...

Code:

Sheets("NPT_Analyse").Range(Cells(3, 4)).Value = Application.WorksheetFunction.VLookup(Sheets("NPT_Analyse").Range(Cells(3, 1)), Sheets("Article").Range(Cells(1, 1), Cells(21, 8)), 3, False)

Mais ca marche toujours pas.

Tu vois une erreur toi de ton côté?

merci d'avance
26/11/2018, 09h52
Ecthelion2

Bonjour,

Pour moi c'est l'argument de ton élément recherché qui n'est pas bon :

Code:

Sheets("NPT_Analyse").Range(Cells(3, 1))

que tu devrais remplacer par

Code:

Sheets("NPT_Analyse").Cells(3, 1)

Lorsque tu utilise des "Cells" dans un "Range", il en faut au moins 2, comme dans ton 2ème argument concernant la plage du tableau, sinon c'est soit Range tout seul, soit Cells tout seul.

Déjà sans être dans un Vlookup, si on essai d'assigne cela :

Code:

Sheets("NPT_Analyse").Range(Cells(3, 1))

à une valeur, on obtient le même message d'erreur que toi.

J'ai fait un code qui fonctionne grâce à la fonction FIND.

Savez vous si je peux encore un peux plus optimiser mon code?

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub remplissage(nom_feuille_origine, num_colonne_origine, nom_feuille_destination, num_colonne_destination)
 
Dim compteur2, max2 As Integer
Dim ref1 As String
Dim range1, PlageDeRecherche As Range
Dim range2 As Integer
 
max2 = max_ligne(nom_feuille_destination, 1)
 
For compteur2 = 3 To max2
 
 Set PlageDeRecherche = Sheets(nom_feuille_origine).Columns(1)
 
 ref1 = Sheets(nom_feuille_destination).Cells(compteur2, 1).Value
 Set range1 = PlageDeRecherche.Cells.Find(what:=ref1, LookAt:=xlWhole)
 
 
 If range1 Is Nothing Then
    Sheets(nom_feuille_destination).Cells(compteur2, num_colonne_destination).Value = "Pas trouvé"
    Selection.Interior.Color = RGB(255, 0, 0)
 Else
    range2 = range1.Row
    Sheets(nom_feuille_destination).Cells(compteur2, num_colonne_destination).Value = Sheets(nom_feuille_origine).Cells(range2, num_colonne_origine).Value
 End If
 
Next
 
 
End Sub

Merci d'avance

Vincent CRESSONNIER

26/11/2018, 09h56
halaster08
Citation:

Envoyé par guismoman60

Personne pour m'aider sur la synthaxe du VLookUp?

Code:

Sheets("NPT_Analyse").Range(Cells(3, 4)).Value = Application.WorksheetFunction.VLookup(Sheets("NPT_Analyse").Range(Cells(3, 1)), Sheets("Article").Range(Cells(1, 1), Cells(21, 8)), 3, False)

Tu dois préciser pour chaque cells la feuille d'où elle provient sinon vba prend la feuille active ce qui peux générer des erreurs
(pour info quand tu n'as qu'une cellule pas besoin d'écrire range(cells) autant écrire cells directement)
Code:

1 2 3 with Sheets("Article") Sheets("NPT_Analyse").Cells(3, 4).Value = Application.WorksheetFunction.VLookup(Sheets("NPT_Analyse").Cells(3, 1), .Range(.Cells(1, 1), .Cells(21, 8)), 3, False) end with

Voir 40 message(s) de cette discussion en une page

Fuseau horaire GMT +2. Il est actuellement 04h39.