[XL-2007] Faire un Vlookup dans une macro et le répéter [Résolu]

Fred4345 · 19/10/2011, 18h03

"Bonjour"
Voici ma recherche : Comment faire pour créer un vlookup qui sera ensuite répéter avec un intervalle de 5 fois sur la même ligne, puis je descends de 6 cellules et je recommence la même opération.
Exemple. La macro commence en A1 puis va en C1, E1,G1,I1 puis descend sur la ligne 6 et recommence. A6-C6-E6-G6-I6; le tous répété 45 fois.
Les valeurs sont recherchés dans le même classeur mais pas sur la même feuille.
J'essaye avec ce code mais cela bloque sur la dernière ligne.

Code :

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

1
2
3
4
5
' Décalage des colonnes pour les composants
If Range(Cells(A2, 4), Cells(A2, 4)).Value = 0 Then Range(Cells(A2 + 2, 4), Cells(A2 + 2, 4)).Value = "" _
    Else
    Range("D6") = _
        WorksheetFunction.VLookup(Range("D4"), Sheets("BASECOMPOSANTS").Range("a1:a1000"), 2, False)

"Merci"

jfontaine · 19/10/2011, 22h02

Bonjour,

Ci dessous une idée pour la boucle

Code :

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

1
2
3
4
5
6
7
8
Dim i As Integer
 
i = 1
 
For i = 1 To 45
    Range("D" & i * 6) = _
        WorksheetFunction.VLookup(Range("D" & i * 6).Offset(-2, 0), Sheets("BASECOMPOSANTS").Range("a1:b1000"), 2, False)
Next i

Fred4345 · 20/10/2011, 08h00

Merci pour la réponse, mais malheureusement le code bloque aussi lorsqu'il arrive sur la constante de la formule.

gFZT82 · 20/10/2011, 08h33

Bonjour,

Ta plage doit comporter à minima deux colonnes de données.
Si tu souhaites que la valeur de la deuxième colonne soit renvoyée, la formule devient

Code :

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

Range("D6") = WorksheetFunction.VLookup(Range("D4"), sheets("BASECOMPOSANTS").Range("A1:B1000"), 2, False)

Cordialement.

Fred4345 · 20/10/2011, 09h32

ça ne fonctionne pas non plus. Voici tous le code de la macro ou j'essaie.

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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
Sub Produit()
 
Dim A1
Dim A2
Dim A3
Dim A4
 
'Calcul du nombre de ligne à traiter dans la feuille 'base'
'Do while
'offset (1,0)
'Loop
 
 
 
 
Dim Produit_1
Dim nvlle_destination1
Dim nvlle_destination2
Dim nvlle_destination3
Dim nvlle_destination4
Dim nvlle_destination5
Dim nvlle_destination6
Dim nvlle_destination7
Dim nvlle_destination8
Dim nvlle_destination9
Dim nvlle_destination10
Dim nvlle_destination11
Dim format
 
A2 = 4
A3 = 1
 
For A1 = 1 To 345 ' Le chiffre 45 sert à faire la boucle pour tout les tableaux
 
Sheets("DEMANDE").Select
 
Range(Cells(A2, 3), Cells(A2, 3)).Select ' Correspond à la cellule ("C4")
Produit_1 = Range(Cells(A2, 3), Cells(A2, 3)).Value ' Détermine la valeur de ("C4")
 
 
    For Each C In Sheets("base").Range("A1:A1000") ' Recherche les composants dans la feuille ("base")
    If Produit_1 = C.Value Then ' Valeur de l'item recherché en ("C4")
    nvlle_destination1 = C.Offset(0, 1).Value ' Choisit le premier composant dans la feuille ("base")
    nvlle_destination2 = C.Offset(0, 2).Value ' Choisit le deuxième composant dans la feuille ("base")
    nvlle_destination3 = C.Offset(0, 3).Value ' Choisit le troisième composant dans la feuille ("base")
    nvlle_destination4 = C.Offset(0, 4).Value
    nvlle_destination5 = C.Offset(0, 5).Value
    nvlle_destination6 = C.Offset(0, 6).Value
    nvlle_destination7 = C.Offset(0, 7).Value
    nvlle_destination8 = C.Offset(0, 8).Value
    nvlle_destination9 = C.Offset(0, 9).Value
    nvlle_destination10 = C.Offset(0, 10).Value
    nvlle_destination11 = C.Offset(0, 11).Value
    format = C.Offset(0, 13).Value ' Choisit le format dans la feuille ("base")
 
    ActiveCell.Offset(0, 1).Value = nvlle_destination1 ' Renvoi la valeur du premier composant dans la feuille ("demande")
    ActiveCell.Offset(0, 2).Value = nvlle_destination2 ' Renvoi la valeur du deuxième composant dans la feuille ("demande")
    ActiveCell.Offset(0, 3).Value = nvlle_destination3 ' Renvoi la valeur du troisième composant dans la feuille ("demande")
    ActiveCell.Offset(0, 4).Value = nvlle_destination4
    ActiveCell.Offset(0, 5).Value = nvlle_destination5
    ActiveCell.Offset(0, 6).Value = nvlle_destination6
    ActiveCell.Offset(0, 7).Value = nvlle_destination7
    ActiveCell.Offset(0, 8).Value = nvlle_destination8
    ActiveCell.Offset(0, 9).Value = nvlle_destination9
    ActiveCell.Offset(0, 10).Value = nvlle_destination10
    ActiveCell.Offset(0, 11).Value = nvlle_destination11
    ActiveCell.Offset(3, -1).Value = format ' Renvoi la valeur du format dans la feuille ("demande")
    GoTo suite ' Sortir de la boucle
    End If
    Next
suite:
 
Dim i As Integer
 
i = 1
 
For i = 1 To 3
 
Range("D6") = WorksheetFunction.VLookup(Range("D4"), Sheets("BASECOMPOSANTS").Range("*_A1:B1000_*"), 2, False)
 
Next i
 
 
A2 = A2 + 6 ' Décalage entre chaque tableau de la feuille ("demande")
 
Next
 
 
 
End Sub

mercatog · 20/10/2011, 12h34

Bonjour
Si j'ai bien compris

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
Sub Produit()
Dim Comp As String, Fami As String
Dim i As Integer
Dim c As Range
 
Application.ScreenUpdating = False
With Worksheets("DEMANDE")
    For i = 4 To 345 Step 6                      'On boucle sur les cellules C de page demande à partir de C4 avec un pas de 6
        Comp = .Range("C" & i)                   'Dans Comp, on mémorise le nom du produit
        If Comp <> "" Then                       'Si comp n'est pas vide
            Set c = Worksheets("base").Range("A:A").Find(Comp, LookIn:=xlValues, lookat:=xlWhole)    ' On recherche les composants dans la colonne A feuille ("base")
            'Si on trouve le produit
            If Not c Is Nothing Then
                'on rapporte les données à partir de Base vers les cellules correspondantes dans DEMANDE
                .Range("D" & i & ":N" & i).Value = c.Offset(0, 1).Resize(1, 11).Value
                .Range("B" & i + 3).Value = c.Offset(0, 13).Value
                'Dans Fami, on mémorise la famille composant D4, D10....
                Fami = .Range("D" & i).Value
                'Si fami est non vide
                If Fami <> "" Then
                    'on cherche dans BASECOMPOSANTS Fami
                    Set c = Worksheets("BASECOMPOSANTS").Range("A:A").Find(Fami, LookIn:=xlValues, lookat:=xlWhole)
                    'Si on le trouve
                    If Not c Is Nothing Then
                        'On rapporte la donnée en D6, D10....
                        .Range("D" & i + 2).Value = c.Offset(0, 1)
                        'On vide la variable objet c
                        Set c = Nothing
                    Else
                        .Range("D" & i + 2) = ""
                    End If
                End If
            Else
                'on vide les cellules si on ne trouve pas de produit
                .Range("D" & i & ":N" & i).Value = ""
                .Range("B" & i + 3).Value = ""
                .Range("D" & i + 2) = ""
            End If
        End If
    Next i
End With
End Sub

Fred4345 · 20/10/2011, 14h19

Merci car tu es sur la bonne voie, tu as bien compris!

Il manque juste les composants pour les colonnes F,H,J,L,M. Sinon le code reporte bien tous le reste. Il va bien chercher ceux pour la colonne D6, D12, D18 etc mais pas ceux des cellules F,H,J,L,M. Dans le cas ou je rajoute des tableaux au delà de 45, il me suffit juste de changer la valeur 345 de "i" si j'ai bien compris?

mercatog · 20/10/2011, 14h32

Citation:

Merci car tu es sur la bonne voie

C'est toi maintenant qui doit être sur la bonne voie pour reporter les cellules que tu veux et là où tu souhaite.
Sinon pour la question sur la dernière ligne remplie de ta feuille

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
Sub Produit()
Dim Comp As String, Fami As String
Dim LastLig As Long, i As Long
Dim c As Range
 
Application.ScreenUpdating = False
With Worksheets("DEMANDE")
    LastLig = .Cells(.Rows.Count, "C").End(xlUp).Row
    For i = 4 To LastLig Step 6                  'On boucle sur les cellules C de page demande à partir de C4 avec un pas de 6
        Comp = .Range("C" & i)                   'Dans Comp, on mémorise le nom du produit
        If Comp <> "" Then                       'Si comp n'est pas vide
            Set c = Worksheets("base").Range("A:A").Find(Comp, LookIn:=xlValues, lookat:=xlWhole)    ' On recherche les composants dans la colonne A feuille ("base")
            If Not c Is Nothing Then             'Si on trouve le produit
                .Range("D" & i & ":N" & i).Value = c.Offset(0, 1).Resize(1, 11).Value    'on rapporte les données à partir de Base vers les cellules correspondantes dans DEMANDE
                .Range("B" & i + 3).Value = c.Offset(0, 13).Value
                Fami = .Range("D" & i).Value     'Dans Fami, on mémorise la famille composant D4, D10....
                If Fami <> "" Then               'Si fami est non vide
                    Set c = Worksheets("BASECOMPOSANTS").Range("A:A").Find(Fami, LookIn:=xlValues, lookat:=xlWhole)    'on cherche dans BASECOMPOSANTS Fami
                    If Not c Is Nothing Then     'Si on le trouve
                        .Range("D" & i + 2).Value = c.Offset(0, 1)    'On rapporte la donnée en D6, D10....
                        'ici tu ajoute les cellules à reporter en fonction de l'offset sur la cellule trouvée c
                        Set c = Nothing          'On vide la variable objet c
                    Else
                        .Range("D" & i + 2) = ""
                    End If
                End If
            Else
                .Range("D" & i & ":N" & i).Value = ""    'on vide les cellules si on ne trouve pas de produit
                .Range("B" & i + 3).Value = ""
                .Range("D" & i + 2) = ""
            End If
        End If
    Next i
End With
End Sub

Relis le code et ses commentaires et adapte.

Fred4345 · 20/10/2011, 15h04

J'aimerai te dire qu'effectivement je suis sur la bonne voie, sauf que je suis complètement novice en vba et que je ne comprends pas du tout ce que je copie.

Du moins j'essaye, mais là ce n'est pas du tout de mon niveau!

Merci pour ton aide.

mercatog · 20/10/2011, 15h09

C'est pas une excuse pour copier sans comprendre.
C'est ton projet, ici on te donne des pistes et on t'aide à comprendre mais aucunement faire ton travail de A à Z.

Le forum est ici pour répondre à des question précises sur les lignes de code que tu n'as pas comprises.

Fred4345 · 20/10/2011, 20h11

Je sais bien, et j'essaye de comprendre pour progresser. Mais là, il faut reconnaître que pour un débutant novice, c'est quand même très compliqué à suivre. La leçon est un peu dur.
Merci pour ton aide et tes conseils.

Après plus de 4h d'essai je n'ai toujours rien trouvé pour continuer. J'essaye toujours de rapporter toutes les valeurs dans la colonne F. C'est possible de me mettre le code pour passer sur la F afin de comprendre le cheminement svp?
Voici ou je suis arrêté. Cela ne fonctionne pas mais ne bloque pas non plus!

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
Sub Produit1()
Dim Comp As String, Fami As String, Fami1 As String
Dim LastLig As Long, i As Long
Dim c As Range
 
Application.ScreenUpdating = False
With Worksheets("DEMANDE")
    LastLig = .Cells(.Rows.Count, "C").End(xlUp).Row
    For i = 4 To LastLig Step 6                  'On boucle sur les cellules C de page demande à partir de C4 avec un pas de 6
        Comp = .Range("C" & i)                   'Dans Comp, on mémorise le nom du produit
        If Comp <> "" Then                       'Si comp n'est pas vide
            Set c = Worksheets("base").Range("A:A").Find(Comp, LookIn:=xlValues, lookat:=xlWhole)    ' On recherche les composants dans la colonne A feuille ("base")
            If Not c Is Nothing Then             'Si on trouve le produit
                .Range("D" & i & ":N" & i).Value = c.Offset(0, 1).Resize(1, 11).Value    'on rapporte les données à partir de Base vers les cellules correspondantes dans DEMANDE
                .Range("B" & i + 3).Value = c.Offset(0, 13).Value
                Fami = .Range("D" & i).Value     'Dans Fami, on mémorise la famille composant D4, D10....
                If Fami <> "" Then               'Si fami est non vide
                    Set c = Worksheets("BASECOMPOSANTS").Range("A:A").Find(Fami, LookIn:=xlValues, lookat:=xlWhole)    'on cherche dans BASECOMPOSANTS Fami
                    If Not c Is Nothing Then     'Si on le trouve
                        .Range("D" & i + 2).Value = c.Offset(0, 1)    'On rapporte la donnée en D6, D10....
                        'ici tu ajoute les cellules à reporter en fonction de l'offset sur la cellule trouvée c
                        Set c = Nothing          'On vide la variable objet c
                    Else
                        .Range("D" & i + 2) = ""
                    End If
                End If
            Else
                .Range("D" & i & ":N" & i).Value = ""    'on vide les cellules si on ne trouve pas de produit
                .Range("B" & i + 3).Value = ""
                .Range("D" & i + 2) = ""
            End If
        End If
 
    Comp = .Range("C" & i)                   'Dans Comp, on mémorise le nom du produit
        If Comp <> "" Then                       'Si comp n'est pas vide
            Set c = Worksheets("base").Range("A:A").Find(Comp, LookIn:=xlValues, lookat:=xlWhole)    ' On recherche les composants dans la colonne A feuille ("base")
            If Not c Is Nothing Then             'Si on trouve le produit
                .Range("F" & i & ":N" & i).Value = c.Offset(0, 3).Resize(1, 11).Value    'on rapporte les données à partir de Base vers les cellules correspondantes dans DEMANDE
                .Range("B" & i + 3).Value = c.Offset(0, 13).Value
                Fami1 = .Range("F" & i).Value     'Dans Fami, on mémorise la famille composant D4, D10....
                If Fami1 <> "" Then               'Si fami est non vide
                    Set c = Worksheets("BASECOMPOSANTS").Range("A:A").Find(Fami1, LookIn:=xlValues, lookat:=xlWhole)    'on cherche dans BASECOMPOSANTS Fami
                    If Not c Is Nothing Then     'Si on le trouve
                        .Range("F" & i + 2).Value = c.Offset(0, 3)    'On rapporte la donnée en D6, D10....
                        'ici tu ajoute les cellules à reporter en fonction de l'offset sur la cellule trouvée c
                        Set c = Nothing          'On vide la variable objet c
                    Else
                        .Range("F" & i + 2) = ""
                    End If
                End If
            Else
                .Range("F" & i & ":N" & i).Value = ""    'on vide les cellules si on ne trouve pas de produit
                .Range("B" & i + 3).Value = ""
                .Range("F" & i + 2) = ""
            End If
        End If
 
    Next i
End With
End Sub

Pour ceux qui souhaitent m'aider en cherchant, voici un lien pour voir le fichier sur lequel je travaille.
http://dl.free.fr/iElZvzak6

mercatog · 20/10/2011, 21h27

Lance la macro Produit (à l'aveuglette si tu le désir)
EDIT

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
Sub Produit()
Dim CodProd As String
Dim LastLig As Long, i As Long
Dim c As Range
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Worksheets("DEMANDE")
    LastLig = .Cells(.Rows.Count, "C").End(xlUp).Row
    For i = 4 To LastLig Step 6
        CodProd = .Range("C" & i)
        If CodProd <> "" Then
            Set c = Worksheets("BASE").Range("A:A").Find(CodProd, LookIn:=xlValues, lookat:=xlWhole)
            If Not c Is Nothing Then
                .Range("D" & i & ":O" & i).Value = c.Offset(0, 1).Resize(1, 12).Value
                .Range("B" & i + 3).Value = c.Offset(0, 13).Value
                Set c = Nothing
                Call RechComp(i)
            Else
                Call Efface(i)
            End If
        End If
    Next i
End With
Application.Calculation = xlCalculationAutomatic
End Sub
 
Private Sub RechComp(ByVal i As Long)
Dim Comp As String
Dim c As Range
Dim j As Byte
 
Application.ScreenUpdating = False
With Worksheets("DEMANDE")
    For j = 4 To 14 Step 2
        Comp = .Cells(i, j).Value
        If Comp <> "" Then
            Set c = Worksheets("BASECOMPOSANTS").Range("A:A").Find(Comp, LookIn:=xlValues, lookat:=xlWhole)
            If Not c Is Nothing Then
                .Cells(i + 2, j).Value = c.Offset(0, 7)
                Set c = Nothing
            Else
                .Cells(i + 2, j).ClearContents
            End If
        End If
    Next j
End With
End Sub
 
Private Sub Efface(ByVal i As Long)
Dim j As Byte
 
Application.ScreenUpdating = False
With Worksheets("DEMANDE")
    .Range("D" & i & ":O" & i).ClearContents
    For j = 4 To 14 Step 2
        .Cells(i + 2, j).ClearContents
    Next j
End With
End Sub

Fred4345 · 20/10/2011, 21h41

Mercatog, merci pour ta réponse. Je viens juste de trouver. Un peu plus de 6h c'est pas mal!

Pas vraiment avec la même méthode que toi par contre. Je te joins mon code pour preuve.

Par contre ce n'est pas exactement ce que je recherche. Je viens de m'en apercevoir en comprenant le code à l'instant.
Pour le premier tableau de la feuille "demande" c'est les valeurs de la colonne H de la feuille "basecomposants" qui doivent apparaître en D6, F6, G6 etc.
Par contre, ensuite il faut que le résultat de la colonne N de la feuille "basecomposants" qui doivent s'afficher en D12, F12, G12 etc de la feuille "demande" et ainsi de suite.

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
Sub Produit1()
Dim Comp As String, Fami As String, Fami1 As String
Dim LastLig As Long, i As Long
Dim c As Range
 
Application.ScreenUpdating = False
With Worksheets("DEMANDE")
    LastLig = .Cells(.Rows.Count, "C").End(xlUp).Row
    For i = 4 To LastLig Step 6                  'On boucle sur les cellules C de page demande à partir de C4 avec un pas de 6
        Comp = .Range("C" & i)                   'Dans Comp, on mémorise le nom du produit
        If Comp <> "" Then                       'Si comp n'est pas vide
            Set c = Worksheets("base").Range("A:A").Find(Comp, LookIn:=xlValues, lookat:=xlWhole)    ' On recherche les composants dans la colonne A feuille ("base")
            If Not c Is Nothing Then             'Si on trouve le produit
                .Range("D" & i & ":N" & i).Value = c.Offset(0, 1).Resize(1, 11).Value    'on rapporte les données à partir de Base vers les cellules correspondantes dans DEMANDE
                .Range("B" & i + 3).Value = c.Offset(0, 13).Value
                Fami = .Range("D" & i).Value     'Dans Fami, on mémorise la famille composant D4, D10....
                If Fami <> "" Then               'Si fami est non vide
                    Set c = Worksheets("BASECOMPOSANTS").Range("A:A").Find(Fami, LookIn:=xlValues, lookat:=xlWhole)    'on cherche dans BASECOMPOSANTS Fami
                    If Not c Is Nothing Then     'Si on le trouve
                        .Range("D" & i + 2).Value = c.Offset(0, 7)    'On rapporte la donnée en D6, D10....
                        'ici tu ajoute les cellules à reporter en fonction de l'offset sur la cellule trouvée c
                        Set c = Nothing          'On vide la variable objet c
                    Else
                        .Range("D" & i + 2) = ""
                    End If
                End If
            Else
                .Range("D" & i & ":N" & i).Value = ""    'on vide les cellules si on ne trouve pas de produit
                .Range("B" & i + 3).Value = ""
                .Range("D" & i + 2) = ""
            End If
        End If
 
        If Comp <> "" Then                       'Si comp n'est pas vide
            Set c = Worksheets("base").Range("A:A").Find(Comp, LookIn:=xlValues, lookat:=xlWhole)    ' On recherche les composants dans la colonne A feuille ("base")
            If Not c Is Nothing Then             'Si on trouve le produit
                .Range("D" & i & ":N" & i).Value = c.Offset(0, 1).Resize(1, 11).Value    'on rapporte les données à partir de Base vers les cellules correspondantes dans DEMANDE
                .Range("B" & i + 3).Value = c.Offset(0, 13).Value
                Fami1 = .Range("F" & i).Value     'Dans Fami, on mémorise la famille composant D4, D10....
                If Fami1 <> "" Then               'Si fami est non vide
                    Set c = Worksheets("BASECOMPOSANTS").Range("A:A").Find(Fami1, LookIn:=xlValues, lookat:=xlWhole)    'on cherche dans BASECOMPOSANTS Fami
                    If Not c Is Nothing Then     'Si on le trouve
                        .Range("F" & i + 2).Value = c.Offset(0, 7)    'On rapporte la donnée en D6, D10....
                        'ici tu ajoute les cellules à reporter en fonction de l'offset sur la cellule trouvée c
                        Set c = Nothing          'On vide la variable objet c
                    Else
                        .Range("F" & i + 2) = ""
                    End If
                End If
            Else
                .Range("D" & i & ":N" & 1).Value = ""    'on vide les cellules si on ne trouve pas de produit
                .Range("B" & i + 3).Value = ""
                .Range("F" & i + 2) = ""
            End If
        End If
 
    Next i
End With
End Sub

mercatog · 20/10/2011, 21h46

A la ligne 40 de mon dernier code (édité) remplace le 1 par i+3

Code :

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

.Cells(i + 2, j).Value = c.Offset(0, i + 3)

Fred4345 · 20/10/2011, 21h50

je t'avoue que là je vais faire un copier coller. Par contre je vais l'étudier de près pour comprendre dès demain (voir même ce soir

). Je ne pense pas que je réussirai à écrire tous ça un jour. Enfin j'espère...

mercatog · 20/10/2011, 21h53

Code final (pour l'instant)

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
Sub Produit()
Dim CodProd As String
Dim LastLig As Long, i As Long
Dim c As Range
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Worksheets("DEMANDE")
    LastLig = .Cells(.Rows.Count, "C").End(xlUp).Row
    For i = 4 To LastLig Step 6
        CodProd = .Range("C" & i)
        If CodProd <> "" Then
            Set c = Worksheets("BASE").Range("A:A").Find(CodProd, LookIn:=xlValues, lookat:=xlWhole)
            If Not c Is Nothing Then
                .Range("D" & i & ":O" & i).Value = c.Offset(0, 1).Resize(1, 12).Value
                .Range("B" & i + 3).Value = c.Offset(0, 13).Value
                Set c = Nothing
                Call RechComp(i)
            Else
                Call Efface(i)
            End If
        End If
    Next i
End With
Application.Calculation = xlCalculationAutomatic
End Sub
 
Private Sub RechComp(ByVal i As Long)
Dim Comp As String
Dim c As Range
Dim j As Byte
 
Application.ScreenUpdating = False
With Worksheets("DEMANDE")
    For j = 4 To 14 Step 2
        Comp = .Cells(i, j).Value
        If Comp <> "" Then
            Set c = Worksheets("BASECOMPOSANTS").Range("A:A").Find(Comp, LookIn:=xlValues, lookat:=xlWhole)
            If Not c Is Nothing Then
                .Cells(i + 2, j).Value = c.Offset(0, i + 3)
                Set c = Nothing
            Else
                .Cells(i + 2, j).ClearContents
            End If
        End If
    Next j
End With
End Sub
 
Private Sub Efface(ByVal i As Long)
Dim j As Byte
 
Application.ScreenUpdating = False
With Worksheets("DEMANDE")
    .Range("D" & i & ":O" & i).ClearContents
    For j = 4 To 14 Step 2
        .Cells(i + 2, j).ClearContents
    Next j
End With
End Sub

Fred4345 · 22/10/2011, 13h48

Dans ce que j'ai copié, le 1 était déjà remplacé par 7. Normal?
Peux tu, si tu as le temps, me mettre des commentaires sur ton code comme tu avais fait pour que j'essaie de comprendre le cheminement stp.
Je te remercie.

Je confirme le dernier code fonctionne! Mon usine à gaz se trouve un peu plus légère!

Merci beaucoup. Vraiment si tu as le temps, merci de me donner les commentaires des lignes du code. J'aimerai bien comprendre. Je n'ai pas dit écrire, mais bien comprendre.

Par contre lorsque la valeur entrée dans la colonne C est en minuscule la macro ne tourne pas. Comment faire pour qu'elle accepte?

Je vais tester sur la feuille des 75 items.

Je ne comprends pas. Pourquoi en changeant juste le noms des feuilles le code ne fonctionne plus? Elles sont à l'identiques des autres, seul le nom des onglets changent. la feuille "base" est commune.
Je joins le code :

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
Sub Produit1()
Dim CodProd As String
Dim LastLig As Long, i As Long
Dim c As Range
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Worksheets("Réalisable")
    LastLig = .Cells(.Rows.Count, "C").End(xlUp).Row
    For i = 4 To LastLig Step 6
        CodProd = .Range("C" & i)
        If CodProd <> "" Then
            Set c = Worksheets("BASE").Range("A:A").Find(CodProd, LookIn:=xlValues, lookat:=xlWhole)
            If Not c Is Nothing Then
                .Range("D" & i & ":O" & i).Value = c.Offset(0, 1).Resize(1, 12).Value
                .Range("B" & i + 3).Value = c.Offset(0, 13).Value
                Set c = Nothing
                Call RechComp1(i)
            Else
                Call Efface1(i)
            End If
        End If
    Next i
End With
Application.Calculation = xlCalculationAutomatic
End Sub
 
Private Sub RechComp1(ByVal i As Long)
Dim Comp As String
Dim c As Range
Dim j As Byte
 
Application.ScreenUpdating = False
With Worksheets("Réalisable")
    For j = 4 To 14 Step 2
        Comp = .Cells(i, j).Value
        If Comp <> "" Then
            Set c = Worksheets("COMPOSANTS").Range("A:A").Find(Comp, LookIn:=xlValues, lookat:=xlWhole)
            If Not c Is Nothing Then
                .Cells(i + 2, j).Value = c.Offset(0, i + 3)
                Set c = Nothing
            Else
                .Cells(i + 2, j).ClearContents
            End If
        End If
    Next j
End With
End Sub
 
Private Sub Efface1(ByVal i As Long)
Dim j As Byte
 
Application.ScreenUpdating = False
With Worksheets("Réalisable")
    .Range("D" & i & ":O" & i).ClearContents
    For j = 4 To 14 Step 2
        .Cells(i + 2, j).ClearContents
    Next j
End With
End Sub

SVP, quelqu'un peut il m'expliquer le code précédant. Il fonctionne avec les feuilles comme Mercatog me l'a donné, mais dès que je change leur nom vba plante sur la ligne 38. Si je change le nom de la variable "comp", la macro fonctionne mais ne rapporte pas toutes les valeurs dans la feuille "réalisable"?

mercatog · 22/10/2011, 14h06

Bonjour
Re décrit ton classeur notamment les noms de tes feuilles et le code que tu utilises (après ton adaptation)

Fred4345 · 22/10/2011, 14h27

Je joins mon fichier. Franchement j'ai tout essayé depuis hier. Je ne comprends vraiment pas. Cela fonctionne avec la feuille "demande", mais pas avec celle "réalisable". Forcément tu vas trouver pourquoi en 30s, mais peux tu me donner le détail de l'endroit ou j'ai pas compris ce qu'il fallait changer stp.http://dl.free.fr/oUKkV8ua0

mercatog · 22/10/2011, 14h33

Je n'ouvre pas les fichiers joints (qu'en cas de force majeur, qui n'est pas le cas ici).
Fais un effort de décrire ton fichier et post ici le code que tu utilise).

20/10/2011, 08h33	#4
gFZT82 Membre Expert Retraité Inscription : avril 2011 Messages : 693 Détails du profil Informations personnelles : Sexe : Localisation : France Informations professionnelles : Activité : Retraité Informations forums : Inscription : avril 2011 Messages : 693 Points : 1 445 Points : 1 445	Bonjour, Ta plage doit comporter à minima deux colonnes de données. Si tu souhaites que la valeur de la deuxième colonne soit renvoyée, la formule devient Code : Sélectionner tout - Visualiser dans une fenêtre à part Range("D6") = WorksheetFunction.VLookup(Range("D4"), sheets("BASECOMPOSANTS").Range("A1:B1000"), 2, False) Cordialement.
	10

20/10/2011, 15h09	#10
mercatog Expert Confirmé Sénior Inscription : juillet 2008 Messages : 5 848 Détails du profil Informations forums : Inscription : juillet 2008 Messages : 5 848 Points : 13 907 Points : 13 907	C'est pas une excuse pour copier sans comprendre. C'est ton projet, ici on te donne des pistes et on t'aide à comprendre mais aucunement faire ton travail de A à Z. Le forum est ici pour répondre à des question précises sur les lignes de code que tu n'as pas comprises. __________________ Cordialement.
	10

20/10/2011, 21h46	#14
mercatog Expert Confirmé Sénior Inscription : juillet 2008 Messages : 5 848 Détails du profil Informations forums : Inscription : juillet 2008 Messages : 5 848 Points : 13 907 Points : 13 907	A la ligne 40 de mon dernier code (édité) remplace le 1 par i+3 Code : Sélectionner tout - Visualiser dans une fenêtre à part .Cells(i + 2, j).Value = c.Offset(0, i + 3) __________________ Cordialement.
	10

22/10/2011, 14h06	#18
mercatog Expert Confirmé Sénior Inscription : juillet 2008 Messages : 5 848 Détails du profil Informations forums : Inscription : juillet 2008 Messages : 5 848 Points : 13 907 Points : 13 907	Bonjour Re décrit ton classeur notamment les noms de tes feuilles et le code que tu utilises (après ton adaptation) __________________ Cordialement.
	10

22/10/2011, 14h33	#20
mercatog Expert Confirmé Sénior Inscription : juillet 2008 Messages : 5 848 Détails du profil Informations forums : Inscription : juillet 2008 Messages : 5 848 Points : 13 907 Points : 13 907	Je n'ouvre pas les fichiers joints (qu'en cas de force majeur, qui n'est pas le cas ici). Fais un effort de décrire ton fichier et post ici le code que tu utilise). __________________ Cordialement.
	10

20/10/2011, 08h00	#3
Fred4345 Candidat au titre de Membre du Club Inscription : juin 2011 Messages : 122 Détails du profil Informations forums : Inscription : juin 2011 Messages : 122 Points : 13 Points : 13	Merci pour la réponse, mais malheureusement le code bloque aussi lorsqu'il arrive sur la constante de la formule.
	00

20/10/2011, 14h19	#7
Fred4345 Candidat au titre de Membre du Club Inscription : juin 2011 Messages : 122 Détails du profil Informations forums : Inscription : juin 2011 Messages : 122 Points : 13 Points : 13	Merci car tu es sur la bonne voie, tu as bien compris! Il manque juste les composants pour les colonnes F,H,J,L,M. Sinon le code reporte bien tous le reste. Il va bien chercher ceux pour la colonne D6, D12, D18 etc mais pas ceux des cellules F,H,J,L,M. Dans le cas ou je rajoute des tableaux au delà de 45, il me suffit juste de changer la valeur 345 de "i" si j'ai bien compris?
	01

20/10/2011, 15h04	#9
Fred4345 Candidat au titre de Membre du Club Inscription : juin 2011 Messages : 122 Détails du profil Informations forums : Inscription : juin 2011 Messages : 122 Points : 13 Points : 13	J'aimerai te dire qu'effectivement je suis sur la bonne voie, sauf que je suis complètement novice en vba et que je ne comprends pas du tout ce que je copie. Du moins j'essaye, mais là ce n'est pas du tout de mon niveau! Merci pour ton aide.
	01

20/10/2011, 21h50	#15
Fred4345 Candidat au titre de Membre du Club Inscription : juin 2011 Messages : 122 Détails du profil Informations forums : Inscription : juin 2011 Messages : 122 Points : 13 Points : 13	je t'avoue que là je vais faire un copier coller. Par contre je vais l'étudier de près pour comprendre dès demain (voir même ce soir ). Je ne pense pas que je réussirai à écrire tous ça un jour. Enfin j'espère...
	01

22/10/2011, 14h27	#19
Fred4345 Candidat au titre de Membre du Club Inscription : juin 2011 Messages : 122 Détails du profil Informations forums : Inscription : juin 2011 Messages : 122 Points : 13 Points : 13	Je joins mon fichier. Franchement j'ai tout essayé depuis hier. Je ne comprends vraiment pas. Cela fonctionne avec la feuille "demande", mais pas avec celle "réalisable". Forcément tu vas trouver pourquoi en 30s, mais peux tu me donner le détail de l'endroit ou j'ai pas compris ce qu'il fallait changer stp.http://dl.free.fr/oUKkV8ua0
	01

Outils de la discussion
Afficher une version imprimable Envoyer un lien vers cette page par email