Deux for each imbriqués ?

**thomanneca** · 06/08/2014, 22h31

Bonjour à tous,

Mon problème est le suivant :

J'ai un tableau de données à double entrées c-a-d que dans ma prem colonne j'ai 1, 2,3 4, 5, etc et dans la première ligne a, b, c, d, e, etc. Toutes les autres cellules de ce tableau sont vides.

J'ai ensuite un second tableau dans lequel est repris un agenda complet d'une année.

A côté de chacun des jours de l'année, je peux inscrire un code de type 2a, 5c, 1b, etc...

Par exemple :

05/05/2014 - 2a
06/05/2014 - 5c
07/05/2014 - 1b
...

Je souhaite à présent constituer une macro qui remplisse mon tableau de données suivant le code repris dans l'agenda.

Pas exemple, en ligne 1 et colonne b, je devrais retrouver la date du 07/05/2014.

J'espère être clair.

Je parviens à utiliser for each pour rechercher une valeur quelque part, la fonction offset également mais je ne parviens pas à imbriquer deux for each l'un dans l'autre. A moins que l'on ne puisse faire autrement?

Quelqu'un aurait-il une idée brillante ?

On pourrait se servir du début de code suivant :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
    Dim Annuel, Donnee As Range
    Dim Cell1, Cell2 As Range
 
    Set Annuel = Sheets("Planning").Range("A1:H20")
    Set Donnee = Sheets("Centrales").Range("H20:J26")
 
    For Each Cell1 In Annuel
        If for each Cell2 in Donnee
 
        Cell1.Value = Sheets("Centrales").Cell2.End(xlToLeft).Value = "1" And Cell.End(xlUp).Value = "b" Then
 
        Cell.Offset(0, -1).Value
        End If
    Next

Un grand merci à tous

**aym52** · 06/08/2014, 22h56

Bonjour, ce code doit répondre à votre problématique, mais je pense que l'on peut trouver plus simple et surtout plus rapide.

Attention au format des chiffres je l'ai convertis en texte.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub test()
Dim C As Range, M As Range, N As Range
For Each C In Range("A10:A11")
temp1 = Left(C.Value, 1)
temp2 = Right(C.Value, 1)
For Each N In Range("A2:A7")
If N.Value = temp2 Then nbligne = N.Row
For Each M In Range("b1:f1")
If CStr(M.Value) = temp1 Then nbcol = M.Column
Next M
Next N
Cells(nbligne, nbcol).Value = C.Offset(0, 1).Value
Next C
End Sub

**thomanneca** · 07/08/2014, 09h46

Bonjour

Merci mais je ne suis pas sur de comprendre, je le teste sur une feuille vierge mais j'ai une erreur 1004.
Ou dois je faire attention au format des chiffres?

Je pense que le code suivant pourrait faire un bon début mais j'ai toujours mon problème de FOR EACH imbriqués..

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
Dim MyRangeAnnuel As Range, EtatAvancement As Range
    Dim k, m, n As String
 
    Set MyRangeAnnuel = Sheets("Planning").Range("D6:DR37")
    Set EtatAvancement = Sheets("Centrales").Range("G19:J26")
 
    For Each Cell In EtatAvancement
        k = Cell.End(xlToLeft).Value
        m = Cell.End(xlUp).Value
        For Each Cell In MyRangeAnnuel
            If Cell.Value = k & m Then
                n = Cell.Offset(0, -6).Value
            End If
            Cell.Value = n
        Next Cell
    Next Cell

**had4789** · 07/08/2014, 10h02

Bonjour,

Pourquoi tiens-tu à utiliser une macro?

Je te joins un fichier qui fais ce que tu demandes sans macro.

Si tu tiens absolument à avoir une macro utilise l'enregistreur.

Classeur1.xlsx

**thomanneca** · 07/08/2014, 12h10

Bonjour,

En effet, je crois que c'est cela que je recherche mais plutôt en vba car mon tableau est succeptible de bouger.
Et pour l'enregistreur, je ne vois pas de trop comment l'utiliser ici ?

Merci beaucoup déjà

**had4789** · 07/08/2014, 14h28

Bonjour,

Dans quel proportion ton tableau est-il susceptible de bouger?

Pour l'enregistreur, tu l'utilises comme d'habitude puis tu adaptes à la taille de ton tableau.

Dis moi si tu veux quelque chose comme ça:

Tant que la colonne A et la ligne 1 ne sont pas vides, on met dans les cellules dans l'aire (X;Y) la formule =RECHERCHEV ....

Voici le code avec l'enregistreur de Macro pour les colonnes B à D.

Tu n'as plus qu'à l'adapter en spécifiant la dernière ligne et la dernière colonne.

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
Sub Macro1()
 
 
 
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1] & R1C2,Feuil2!R1C1:R3C2,2,0)"
    Range("B2").Select
    Selection.AutoFill Destination:=Range("B2:B15"), Type:=xlFillDefault
 
    Range("B2:B15").Select
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2] & R1C3,Feuil2!R1C1:R3C2,2,0)"
    Range("C2").Select
    Selection.AutoFill Destination:=Range("C2:C15"), Type:=xlFillDefault
 
    Range("C2:C15").Select
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-3] & R1C4,Feuil2!R1C1:R3C2,1,0)"
    Range("D2").Select
    Selection.AutoFill Destination:=Range("D2:D15"), Type:=xlFillDefault
 
 
    Range("B2:D15").Select
    Selection.NumberFormat = "m/d/yyyy"
 
End Sub

**aym52** · 07/08/2014, 14h45

Envoyé par thomanneca

Je pense que le code suivant pourrait faire un bon début mais j'ai toujours mon problème de FOR EACH imbriqués..

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
Dim MyRangeAnnuel As Range, EtatAvancement As Range
    Dim k, m, n As String
 
    Set MyRangeAnnuel = Sheets("Planning").Range("D6:DR37")
    Set EtatAvancement = Sheets("Centrales").Range("G19:J26")
 
    For Each Cell In EtatAvancement
        k = Cell.End(xlToLeft).Value
        m = Cell.End(xlUp).Value
        For Each Cell In MyRangeAnnuel
            If Cell.Value = k & m Then
                n = Cell.Offset(0, -6).Value
            End If
            Cell.Value = n
        Next Cell
    Next Cell

A mon sens le problème de votre code est le "Cell" vous l'utilisez dans les deux boucles, ce qui peux perturber.

En relisant, je me suis aperçu que j'ai inversé vos entête de ligne et de colonne dans le code que je vous ai transmis.
Sur mon micro la procédure marche, quelle est l'anomalie qui ressort (je suis sous 2013).

**thomanneca** · 08/08/2014, 00h00

@had4789Bonsoir,

J'étais parvenu à enregistrer un code de ce type avec l'enregistreur mais il ne me semblait pas très "catholique",
n'y aurait-il pas un code plus simple que celui-la ?
VBA ne prévoit-il pas ce genre de fonction ?

Sinon le fichier joint reprend bien mon objectif !! c'est un très bon début

Et pour répondre à ta question, mon tableau ne devrait pas changer des masses, genres quelques colonnes et/ou lignes (une cinquantaine grand max).

Merci

Re,

Je l'ai un peu modifié par rapport à Cell, la il fonctionne mais me renvoie de mauvaises info :-S
On y est presque...

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
Sub MettreAJourAgenda()
    Dim MyRangeAnnuel As Range, EtatAvancement As Range
    Dim k, m, n As String
    Dim cell1, cell2 As Range
 
    Set MyRangeAnnuel = Sheets(1).Range("B1:B11")
    Set EtatAvancement = Sheets(2).Range("B2:F11")
 
    For Each cell1 In EtatAvancement
        k = cell1.End(xlToLeft).Value
        m = cell1.End(xlUp).Value
        For Each cell2 In MyRangeAnnuel
            If cell2.Value = k & m Then
                cell1.Value = cell2.Offset(0, -1).Value
            End If
        Next
    Next
End Sub

**had4789** · 08/08/2014, 09h03

Bonjour,

Nous ne sommes pas devin. Quand tu dis " il renvoie de mauvaises infos", pourquoi ces infos sont mauvaises?

Il y a quel type de décalage?

Je ne suis pas expert mais je pense qu'il faudrait peut-être que tu modifies tes NEXT par NEXT Cell1 Next Cell2.

**thomanneca** · 08/08/2014, 09h17

Bonjour,

Il me renvoie bien une date mais cela ne correspond pas avec les dates entrées dans le tableau.
Et les cellules qui devraient renvoyer une donnée ne sont pas toutes remplies...

Pas évident d'expliquer, je vais poursuivre ma recherche mais si tu as une idée

**had4789** · 08/08/2014, 13h50

Le plus simple pour trouver l'erreur c'est de réduire ton fichier au minimum puis de faire ta macro pas à pas.

Envois un classeur vierge que je regarde

**thomanneca** · 09/08/2014, 10h58

Bonjour,

Voici un classeur simplifié.

La macro marche mais comme tu le verras (cases en jaune), elle ne fonctionne pas totalement.
Apparemment les cellules remplies sont correctes ici.

Merci pour ton avis

**Theze** · 10/08/2014, 15h16

Bonjour,

Je n'ai pas lu tout le fil mais je suppose que tu souhaite inscrire le numéro et la lettre correspondant en colonne B de la feuille "Feuil1" ?
Tout d'abords, évite d'utiliser comme variable des mots qui sont utilisés par VB comme par exemple Feuil1 et Feuil2. Regarde pourquoi :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
Sub Test()
 
    Dim I As Integer
 
    For I = 1 To Application.VBE.ActiveVBProject.VBComponents.Count
 
        MsgBox Application.VBE.ActiveVBProject.VBComponents(I).Name
 
    Next I
 
End Sub

tu vois ici, après lancement de la macro que ces mots sont utilisés par VB.
Teste le code ci-dessous pour voir si il correspond à ta demande :

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
 
Sub MettreAJourAgenda()
 
    Dim PlageFe1 As Range
    Dim PlageFe2 As Range
    Dim Cel As Range
    Dim CelTrouve As Range
 
    'défini la plage des dates à chercher sur la colonne A de la feuille "Feuil1"
    With Worksheets("Feuil1")
 
        Set PlageFe1 = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
 
    End With
 
    'défini la plage de recherche sur la feuille "Feuil2"
    With Worksheets("Feuil2")
 
        Set PlageFe2 = .Range(.Cells(2, 2), _
                        .Cells(.Cells.Find("*", .[A1], -4123, , _
                        1, 2).Row, .Cells.Find("*", .[A1], -4123, , _
                        2, 2).Column))
 
    End With
 
    'parcour la plage de dates en effectuant une recherche dans la feuille "Feuil2"
    For Each Cel In PlageFe1
 
        Set CelTrouve = PlageFe2.Find(Cel.Value, , xlValues, xlWhole)
 
        If Not CelTrouve Is Nothing Then
 
            'inscrit en colonne B de la feuille "Feuil1" le numéro et la lettre conrrespondant
            Cel.Offset(, 1).Value = CelTrouve.Offset(, -CelTrouve.Column + 1).Value & CelTrouve.Offset(-CelTrouve.Row + 1, 0).Value
 
        End If
 
    Next Cel
 
End Sub

Hervé.

**thomanneca** · 10/08/2014, 22h50

Merci pour la réponse.

En fait, il me semble que je cherche à faire l'inverse de ce que tu me donnes ci-dessus.

Pour résumé, j'ai un tableau agenda en feuil1 avec donc pas mal de colonnes.
En feuil2 j'ai un autre tableau données avec ma première colonne (1, 2, 3, etc) et ma première ligne (a, b, c, d, etc).

L'objectif est que dès que j'inscris par exemple 1a à côté du 1/04/2014, la date soit renvoyée dans mon tableau au bon endroit.

Mon classeur ci-avant annexé est presque ok sauf que toutes les dates ne reviennent pas..

Je vais un peu regarder ton code en l'inversant pour voir si cela pourrait faire l'affaire.

Bonsoir,

Avec le code ci-dessous (même code que dans le fichier joint ci-avant), je constate en réalité que lorsque mon tableau contient des cellules vides, les données ne sont pas toutes récupérées... ?

Y a-t-il une raison à cela ? Car je pense que la sera ma solution !!!

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
Dim Fe1 As Range, Fe2 As Range
    Dim k, m, n As String
 
    Dim cell1, cell2 As Range
    Set Fe1 = Sheets(1).Range("B1:B10")
    Set Fe2 = Sheets(2).Range("B2:F10")
 
    For Each cell1 In Fe2
        k = cell1.End(xlToLeft).Value
        m = cell1.End(xlUp).Value
        For Each cell2 In Fe1
            If cell2.Value = k & m Then
                cell1.Value = cell2.Offset(0, -1).Value
            End If
        Next
    Next

**Theze** · 11/08/2014, 07h29

Bonjour,

Alors de cette façon peut-être ?

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
 
Sub MettreAJourAgenda()
 
    Dim Plage As Range
    Dim Cel As Range
    Dim I As Integer
    Dim Lgn As String
    Dim Col As String
 
    'défini la plage
    With Worksheets("Feuil1")
 
        Set Plage = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
 
    End With
 
    For Each Cel In Plage
 
        'construction de l'adresse
        For I = 1 To Len(Cel.Offset(, 1).Value)
 
            If IsNumeric(Mid(Cel.Offset(, 1).Value, I, 1)) Then
 
                lng = lng & Mid(Cel.Offset(, 1).Value, I, 1)
 
            Else
 
                Col = Col & Mid(Cel.Offset(, 1).Value, I, 1)
 
            End If
 
        Next I
 
        'inscription de la date
        With Worksheets("Feuil2")
 
            .Range(Col & lng).Offset(1, 1).Value = Cel.Value
 
        End With
 
        Col = ""
        lng = ""
 
    Next Cel
 
End Sub

Hervé.

**thomanneca** · 11/08/2014, 22h48

Bonsoir,

Je crois que ton code me donne exactement ce que je cherche.
Maintenant je dois le retranscrire dans mon classeur agenda et pour cela j'ai besoin de 2-3 explications supplémentaires

Pourrais-tu me traduire ce code en quelques mots en français svp car il y certains passages qui m'échappent..

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
With Worksheets("Feuil1")
        Set Plage = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
    End With
    For Each Cel In Plage
        'construction de l'adresse
        For I = 1 To Len(Cel.Offset(, 1).Value)
            If IsNumeric(Mid(Cel.Offset(, 1).Value, I, 1)) Then
                lng = lng & Mid(Cel.Offset(, 1).Value, I, 1)
            Else
                Col = Col & Mid(Cel.Offset(, 1).Value, I, 1)
            End If
        Next I
        'inscription de la date
        With Worksheets("Feuil2")
            .Range(Col & lng).Offset(1, 1).Value = Cel.Value
        End With
        Col = ""
        lng = ""

Merci

Te donne pas la peine, je pense que je l'ai compris.
Un détail que je n'avais pas dit et qui s'avère être important lorsque j'utilise ton code dans ma feuille est que mon tableau agenda comprend 36 colonnes (3 colonnes / mois), dans la première se trouve la date, dans la seconde du texte et dans la troisième un code quelconque.. de type 103TC1, 103TC2, 105TC3, etc.
En gros, j'ai voulu faire simple mais cela n'a pas payé :s
Si tu as encore un peu de temps à me consacrer...

dans le cas contraire, je te remercie pour cette aide. Je m'en servirai.

**Theze** · 12/08/2014, 08h35

Bonjour,

Si j'ai bien compris, les colonnes ne sont en fait pas disposées comme dans ton exemple mais par trois ? Si c'est le cas, regarde si ça convient. Les explications sont dans 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
Sub MettreAJourAgenda()
 
    Dim Plage As Range
    Dim Cel As Range
    Dim I As Integer
    Dim Lgn As String
    Dim Col As String
 
    'défini la plage des dates en colonne "A" de la feuille "Feuil1"
    With Worksheets("Feuil1")
 
        Set Plage = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
 
    End With
 
    'parcour la plage
    For Each Cel In Plage
 
        'sépare le numéro de ligne de la ou les lettres de colonne
        For I = 1 To Len(Cel.Offset(, 1).Value)
 
            If IsNumeric(Mid(Cel.Offset(, 1).Value, I, 1)) Then
 
                lng = lng & Mid(Cel.Offset(, 1).Value, I, 1)
 
            Else
 
                Col = Col & Mid(Cel.Offset(, 1).Value, I, 1)
 
            End If
 
        Next I
 
        'inscription de la date en feuille "Feuil2" dans la case correspondante
        'avec un décalage de colonnes vers la droite et d'une ligne vers le bas
        'car il faut prendre en compte les entêtes de lignes et colonnes ainsi
        'que le décalage dû au trois colonnes par mois
        With Worksheets("Feuil2")
 
            .Cells(lng + 1, (Asc(Col) - 97) * 3 + 2).Value = Cel.Value
 
        End With
 
        'vide les variable pour la date suivante
        Col = ""
        lng = ""
 
    Next Cel
 
End Sub

Hervé.

Re,

Petite précision sur cette partie du code :

Code :

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

(Asc(Col) - 97) * 3 + 2)

La fonction Asc() revoit le code du caractère passé en argument. Comme le code de la première lettre ("a") est 97, on retire cette valeur à la valeur retournée par la fonction on multiplie par 3 pour les 3 colonnes par mois et ensuite on rajoute 2 pour prendre en compte la colonne d'entêtes de lignes et la base 1 des colonnes (il n'existe pas de colonne 0).

Hervé.

**thomanneca** · 13/08/2014, 18h33

Merci pour ton explication, j'avance encore d'un pas mais pas le bon dans ce cas-ci.
Pour faire simple et qu'on se comprenne mieux, voici un autre classeur qui représente à peu de choses près l'objectif à atteindre.
En fait, chaque mois est repris sur une colonne puis.. tu vas voir.

Je pense en réalité que la meilleure fonction ici serait d'utiliser le FIND(...) mais je ne parviens pas encore à le mettre en écriture. Qu'en penses-tu ?

Merci pour ton aide précieuse.

Voici la feuille, je n'y ai pas encore mis de code :

agenda.xlsx

**thomanneca** · 13/08/2014, 19h17

Re,

Voilà enfin le code qu'il me fallait ! Il fonctionne je crois !

Je marque résolu et vous remercie tous pour votre aide.

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
Dim Lng, Col, o As String
    Dim PlageFe1, PlageFe2 As Range
 
    Set PlageFe1 = Sheets("Planning").Range("D6:DR37")
    Set PlageFe2 = Sheets("Centrales").Range("H20:J26")
 
        For Each Cell1 In PlageFe2
            Lng = Cell1.End(xlToLeft).Value
            Col = Cell1.End(xlUp).Value
            o = Lng & Col
 
            Set CellTrouvee = PlageFe1.Find(o, lookat:=xlWhole)
            If CellTrouvee Is Nothing Then
                Cell1.Value = "?"
            Else
                Cell1.Value = CellTrouvee.Offset(0, -6).Value
            End If
        Next Cell1
        o = ""
        Lng = ""
        Col = ""

A+

Deux for each imbriqués ? [XL-2013]

Macros et VBA Excel

Discussions similaires

Partager

Partager