Fonction Vlookup en VBA ne marche pas: erreur execution 9

**jgresse1025** · 03/03/2015, 10h02

Bonjour tous le monde,

Je suis débutant en VBA et j'ai un problème avec mon code.
J'ai un problème avec la fonction Vlookup en VBA.
Je n'arrive pas à trouver pourquoi ça ne marche pas.
Je vous mets le code ainsi que les deux fichiers en pièce jointes.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
Private Sub CommandButton1_Click()
 
Dim Bd As Worksheet
Dim Rech As Worksheet
Dim NbLig As Long
Dim NbCol As Long
Dim Derlign As Integer
Set Bd = ThisWorkbook.Sheets("Gamme")
Set Rech = ThisWorkbook.Sheets("Suivi")
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim m As Integer
Dim l As Integer
Dim Resultat As Variant
 
 j = 1
With Bd
 NbLig = .Cells(.Rows.Count, 1).End(xlUp).Row
 NbCol = .Cells(1, .Columns.Count).End(xlToRight).Column
End With
 
For i = 2 To NbLig
If Suivi_gamme.ComboBox1.Value = Bd.Cells(i, 1).Value Then
     If Suivi_gamme.ComboBox2.Value = Bd.Cells(i, 2).Value Then
         If Suivi_gamme.ComboBox3.Value = Bd.Cells(i, 3).Value Then
         For k = 4 To NbCol
             If Bd.Cells(i, k).Text Like "Fil" Or Bd.Cells(i, k).Text Like "V22" Or Bd.Cells(i, k).Text Like "Drill 20" Or Bd.Cells(i, k).Text Like "Sodick" Then
                 If Bd.Cells(i, k + 1).Value = Bd.Cells(i, k).Value Then
 
                 Else
                 Rech.Cells(j + 8, 1).Value = Bd.Cells(1, k).Value
                 Bd.Cells(i, k).Copy
                 Rech.Cells(j + 8, 2).PasteSpecial xlPasteValuesAndNumberFormats
                 j = j + 1
                 End If
             End If
         Next k
         End If
      End If
End If
Next i
 
For l = 9 To 23
 Rech.Range("C" & l).Interior.ColorIndex = xlColorIndexNone
Next l
 
For l = 9 To 23
If Rech.Cells(l, 2).Text Like "Fil" Or Rech.Cells(l, 2).Text Like "Drill 20" Then
    Resultat = Application.VLookup(Rech.Cells(4, 2).Value, Workbooks("C:\Users\mto\Desktop\Suivi_Mc_FIL.xlsx").Sheets("2015").Range("C6:J500"), 1, False)
  If IsError(Resultat) Then
     Rech.Range("C" & l).Interior.ColorIndex = 10
     Else
     Rech.Range("C" & l).Interior.ColorIndex = 3
     End If
End If
Next l
 
 Unload Me
End Sub

Je n'arrive pas à voir pourquoi ça ne marche pas.
Quand je fait débogage, l'erreur se trouve se la ligne:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Resultat = Application.VLookup(Rech.Cells(4, 2).Value, Workbooks("C:\Users\mto\Desktop\Suivi_Mc_FIL.xls") .Sheets("2015").Range("C6:J500"), 1, False)

(Ce n'est qu'un exemple car il va me falloir lire dans 3 fichiers en tout mais si dans un ça marche, ça devrait marcher pour les 3 après)

Merci d'avance pour votre aide

Invité · 03/03/2015, 12h38

Bonjour,
si une occurrence n'est pas trouvé, ça ce matérialise par une erreur!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
If Rech.Cells(l, 2).Text Like "Fil" Or Rech.Cells(l, 2).Text Like "Drill 20" Then
Resultat = ""
On Error Resume Next
    Resultat = Application.VLookup(Rech.Cells(4, 2).Value, Workbooks("C:\Users\RDurupt\Desktop\Suivi_Mc_FIL.xls").Sheets("2015").Range("C6:J500"), 1, False)
On Error GoTo 0
    If Resultat = "" Then
                Rech.Range("C" & l).Interior.ColorIndex = 10
         Else
            Rech.Range("C" & l).Interior.ColorIndex = 3
        End If
    End If
Next l

**jgresse1025** · 03/03/2015, 13h22

Merci beaucoup de ton aide, ça marche.

**jgresse1025** · 03/03/2015, 13h37

Rebonjour,

Le code que tu m'as donnée rdurupt marche mais cependant il y a un problème.
En effet, lorsque que j'effectue mon suivi avec mon fomulaire, quand je sélectionne le numéro de dossier, la référence et le nom de la pièce, ça me mets la couleur rouge alors que ça devrait me le mettre en vert car ce que je cherche est bien dans le fichier dans lequel je viens lire.
Je ne vois pas trop pourquoi?

Je te remet les fichier en pièce jointe

Invité · 03/03/2015, 15h08

l'erreur était sur le chement du fichier fermé!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
For l = 9 To 23
    If Rech.Cells(l, 2).Text Like "Fil" Or Rech.Cells(l, 2).Text Like "Drill 20" Then
        Resultat = Application.VLookup(CStr(Rech.Cells(4, 2).Value), Range("'C:\Users\rdurupt\Desktop\[Suivi_Mc_FIL.xlsx]2015'!C6:J500"), 1, False)
        If InStr(1, UCase(CStr(Resultat)), "ERREUR") <> 0 Then
            Rech.Range("C" & l).Interior.ColorIndex = 3
        Else
            Rech.Range("C" & l).Interior.ColorIndex = 10
        End If
    End If
Next l

**jgresse1025** · 03/03/2015, 15h24

J'ai testé ce que tu m'as dis et ça me mais "Erreur execution 1004 La méthode 'Range' de l'objet '_Global' a échoué.

de quoi cela peut provenir ?

Merci d'avance

Invité · 03/03/2015, 15h27

dans le dernier fichier que tu m'as envoyé, la feuille 2015 n'existe pas vérifies le non de tes onglet!

**jgresse1025** · 03/03/2015, 15h53

En effet, l'onglet était mal nommé.
Merci beaucoup pour ton aide

**jgresse1025** · 03/03/2015, 16h01

Je reviens sur le problème.
La recherche marche bien si le fichier dans lequel je viens chercher est ouvert mais par contre quand il est fermé ça me remet l'erreur d'execution 1004.

Je n'arrive pas à savoir pourquoi...

Merci d'avance

Invité · 04/03/2015, 09h19

Bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Dim Wb As Workbook
Set Wb = Workbooks.Open("C:\Users\RDurupt\Desktop\Suivi_Mc_FIL.xlsx")
Dim R As Range
Set R = Wb.Sheets("2015").Range("C6:J500")
For l = 9 To 23
    If Rech.Cells(l, 2).Text Like "Fil" Or Rech.Cells(l, 2).Text Like "Drill 20" Then
        Resultat = Application.VLookup(CStr(Rech.Cells(4, 2).Value), R, 2, False)
        If IsError(Resultat) = True Then
            Rech.Range("C" & l).Interior.ColorIndex = 3
        Else
            Rech.Range("C" & l).Interior.ColorIndex = 10
        End If
    End If
Next l
 Set R = Nothing
 Wb.Close False
 Set Wb = Nothing

**jgresse1025** · 04/03/2015, 09h55

Bonjour rdurupt,

Je te remercie pour ce code qui marche à la perfection.
Je vais maintenant continuer à faire mon code.
Si jamais, j'ai un problème sur un truc que je code, est-il possible que je te contacte par message privé ou sur ce poste ?

Merci beaucoup de ton aide

Invité · 04/03/2015, 10h04

pas de problème

**jgresse1025** · 04/03/2015, 16h15

Rebonjour,

J'ai un petit problème.
En effet, dans mon fichier dans lequel je viens lire, il se peut qu'il y ai plusieurs fois le meme numéro de dossier et meme référence mais pas le même nom de pièce.
Comment puis-je faire pour qu'il me trouve la recherche que je veux ?

Exemple: Dans mon fichier dans lequel je viens lire il y a le numéro de dossier T10-014120 et la référence A113 de rentrer. Et pour ce meme numéro de dossier et référence, il y a la pièce Noyau Couv. et Empreinte éjection Couv.
Quand je viens lire dans le fichier, si ça trouve les informations que je veux, ça me les met d'une certaine couleur. Or la ça ne le fait pas car la fonction prend la première ligne rentré avec le numéro de dossier correspondant à ce que je recherche.
Je ne vois pas comment faire pour que ça ne prenne pas la premiere ligne rentré mais que ca regarde toutes les autres lignes pour voir si il n'y en a pas d'autre avec ce numéro de dossier.

J'espère que c'est compréhensible

Je mets le fichier avec le code et le fichier dans lequel je viens lire en pièce jointe

Merci d'avance

Invité · 04/03/2015, 16h28

regardes ça si ça t'inspire!
http://www.developpez.net/forums/d14...igne-colonne/#

**jgresse1025** · 04/03/2015, 17h56

Merci.
Je vais regarder et essayer de faire quelque chose.
Je te tiens au courant de comment je m'en sors.

**jgresse1025** · 04/03/2015, 19h15

Rebonjour,

J'ai regarder le lien que tu m'as envoyer et je n'arrive pas à trouver comment l'adapter avec mon code et avec ce que je veux faire....
Je ne vois pas comment intégrer la fonction à mon code....

Il n'y a pas d'autre moyen à part la fonction du lien que tu m'as envoyé ?

En fait je voudrais que pour les lignes avec le meme numéro de dossier et meme référence, comparer le nom de la pièce avec celui que j'ai selectionné et si il y ai ca me fait la condition.
Comment puis-je faire.

Merci pour ton aide

Invité · 05/03/2015, 11h33

Bonjour voila en version ADO

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Dim Conn As Object
Set Conn = CreateObject("ADODB.Connection")
Dim mrs As Object
Set mrs = CreateObject("ADODB.Recordset")
sconnect = "Provider=MSDASQL.1;DSN=Excel Files;DBQ=C:\Users\RDurupt\Desktop\Suivi_Mc_FIL.xlsx;HDR=Yes';"
 
Conn.Open sconnect
Dim Sql As String
For l = 9 To 23
    If Rech.Cells(l, 2).Text Like "Fil" Or Rech.Cells(l, 2).Text Like "Drill 20" Then
    Sql = "Select * from [2015$C6:J500] where [Txx-xxxxx]='" & Me.ComboBox1.Text & "' and [Référence pièce Timex]='" & Me.ComboBox2.Text & "' and Description='" & Me.ComboBox3.Text & "' "
    Set mrs = CreateObject("ADODB.Recordset")
    mrs.Open Sql, Conn
        If mrs.EOF = True Then
            Rech.Range("C" & l).Interior.ColorIndex = 3
        Else
            Rech.Range("C" & l).Interior.ColorIndex = 10
        End If
        mrs.Close
        Set mrs = Nothing
    End If
Next l
Conn.Close
 Set Conn = Nothing

**jgresse1025** · 05/03/2015, 12h46

Merci de ton aide.

Je ne connais pas ADO sur excel.
Je vais essayer ce que tu m'as données.
Je ne pense pas que sans ADO, mon problème soit réalisable ?

En tout cas merci

**jgresse1025** · 05/03/2015, 12h50

Ca me mets que sconnect n'est pas définie.
Il faut le définir comme un objet ?

Invité · 05/03/2015, 13h02

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Dim Conn As Object
Set Conn = CreateObject("ADODB.Connection")
Dim mrs As Object
dim sconnect  as string
sconnect = "Provider=MSDASQL.1;DSN=Excel Files;DBQ=C:\Users\RDurupt\Desktop\Suivi_Mc_FIL.xlsx;HDR=Yes';"
 
Conn.Open sconnect
Dim Sql As String
For l = 9 To 23
    If Rech.Cells(l, 2).Text Like "Fil" Or Rech.Cells(l, 2).Text Like "Drill 20" Then
    Sql = "Select * from [2015$C6:J500] where [Txx-xxxxx]='" & Me.ComboBox1.Text & "' and [Référence pièce Timex]='" & Me.ComboBox2.Text & "' and Description='" & Me.ComboBox3.Text & "' "
    Set mrs = CreateObject("ADODB.Recordset")
    mrs.Open Sql, Conn
        If mrs.EOF = True Then
            Rech.Range("C" & l).Interior.ColorIndex = 3
        Else
            Rech.Range("C" & l).Interior.ColorIndex = 10
        End If
        mrs.Close
        Set mrs = Nothing
    End If
Next l
Conn.Close
 Set Conn = Nothing

Envoyé par jgresse1025

Je ne pense pas que sans ADO, mon problème soit réalisable ?

si c'est réalisable plus compliqué d'ou le lien que je t'avais donné!
mais de toute façon je suis plus alaise avec ADO et comme ton fichier est fermé au départ alors qu'il le reste!

Fonction Vlookup en VBA ne marche pas: erreur execution 9 [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager