Boucles "imbriquées"...

Skud · 7 Octobre 2008

Bonjour tout le monde,

Je bloque sur un problème de boucles "imbriquées".
Je m'explique :
Le but du fichier est de faire une fiche récapitulative du tableau et cela par numéro de lot.

On se place sur le lot voulu en colonne A.
On lance la macro.
On complète la fiche récapitulative.
Si dans la colonne A le numéro est présent plusieurs fois (tout à fait possible et même normal)
On continu de compléter la fiche récapitulative.
…etc..
Il faut donc une boucle pour vérifier les numéros de lot dans la colonne A.
Et une pour compléter les infos dans la fiche récapitulative.

Pas sûr d'être très clair là…je joins le fichier exemple.

En tous cas, j'ai retourné les boucles dans tous les sens ou presque puisque je n'ai pas trouvé la solution ;-) alors si quelqu'un à une idée.

Merci.

Ps: Dans le fichier il y a 2 macros, une pour un remplissage sans les boucles : OK et la deuxième c'est ma tentative pour créer les boucles.

Guest · 7 Octobre 2008

Re : Boucles "imbriquées"...

Bonjour Skud,

Voici la boucle corrigée:

Code:

Sub Essai_boucle()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim lot As String
Application.ScreenUpdating = False
i = ActiveCell.Row
j = ActiveCell.Column
lot = Cells(i, j).Value
With Sheets("Feuil1")
.Range("D6").ClearContents
.Range("D10" & ":" & "D103").ClearContents
End With
With Sheets("Feuil1")
    .Range("D6") = Range("D1")
    .Range("D10") = lot
    .Range("D12") = Format(Range("E" & i), "mmm yyyy")
End With
           
[COLOR=red]k = 16
[/COLOR][COLOR=red]For i = 6 To 17 '[/COLOR][COLOR=black]de la premiière ligne à la dernière ligne Feuil2[/COLOR]
    If Cells(i, j).Value = lot Then
        
            With Sheets("Feuil1")
                .Range("D" & k) = Range("C" & i)
                .Range("D" & k + 2) = Range("D" & i)
                .Range("D" & k + 4) = Range("B" & i)
                .Range("D" & k + 6) = Format(Range("G" & i), "mmm yyyy")
            End With
            [COLOR=red]k = k + 9
[/COLOR]    End If
Next i
 
Application.ScreenUpdating = True
End Sub

De façon générale, ce genre de code est à mettre dans un module de code général et non un module de code de feuille, révervé à la gestion d'évènement. Au besoin, faire référence explicitement à la feuil2 comme à la feuil1

A bientôt

porcinet82 · 7 Octobre 2008

Re : Boucles "imbriquées"...

Salut,

Une petite solution avec un booléen 😛 :

Code:

Sub Essai_boucle()
Dim k As Integer
Dim lot As String
Dim bool As Boolean
Dim lig As Integer
Application.ScreenUpdating = False
lot = ActiveCell.Value
bool = False
With Sheets("Feuil1")
    .Range("D6").ClearContents
    .Range("D10" & ":" & "D103").ClearContents
End With
For k = 6 To Range("A65536").End(xlUp).Row
    If Cells(k, 1).Value = lot Then
        If bool = False Then
            With Sheets("Feuil1")
                .Range("D6") = Range("D1")
                .Range("D10") = lot
                .Range("D12") = Format(Range("E" & k), "mmm yyyy")
                lig = 16
                bool = True
            End With
        End If
        With Sheets("Feuil1")
            .Range("D" & lig) = Range("C" & k)
            .Range("D" & lig + 2) = Range("D" & k)
            .Range("D" & lig + 4) = Range("B" & k)
            .Range("D" & lig + 6) = Format(Range("G" & k), "mmm yyyy")
            lig = lig + 9
        End With
    End If
Next k
Application.ScreenUpdating = True
End Sub

@+

Skud · 7 Octobre 2008

Re : Boucles "imbriquées"...

Bonjour Hasco et Porcinet82,

Merci pour vos solutions respectives qui fonctionnent toutes les deux à merveille.

Hasco : Je vais suivre tes conseils et placer le code dans un module de code général, d'autant que le fichier comporte réellement une cinquantaine d'onglets sur lesquels je souhaite effectuer cette manip pour obtenir une fiche récapitulative.

Porcinet82 : J'étudie ta solution car je ne connais pas du tout le "système" Booléen.

Encore merci pour votre aide et votre rapidité.

Bonne journée à tous.

pierrejean · 7 Octobre 2008

Re : Boucles "imbriquées"...

bonjour Skud

Salut à mes amis Hasco 🙂 et Romain 🙂

Ma version (avec un brin de retard)
Note : j'ai mentionné les diverses dates de fabrication

Code:

Sub boucle()
Dim ligne As Integer
Dim n As Integer
Dim achercher As Variant
achercher = ActiveCell
ligne = 16
With Sheets("Feuil1")
.Range("D10" & ":" & "D103").ClearContents
.Range("D6") = Range("D1")
.Range("D10") = achercher
End With
For n = 6 To Range("A65536").End(xlUp).Row
  If Range("A" & n) = achercher Then
     With Sheets("Feuil1")
     .Range("D" & ligne) = Range("C" & n)
     .Range("D" & ligne + 2) = Range("D" & n)
     .Range("D" & ligne + 4) = Range("B" & n)
     .Range("D" & ligne + 6) = Range("G" & n)
     .Range("D12") = .Range("D12") & Range("E" & n) & " - "
     End With
     ligne = ligne + 9
  End If
Next n
Sheets("Feuil1").Range("D12") = Left(Sheets("Feuil1").Range("D12"), Len(Sheets("Feuil1").Range("D12")) - 2)
End Sub

Skud · 7 Octobre 2008

Re : Boucles "imbriquées"...

Bonjour PierreJean,

Merci à toi aussi de t'être penché sur mon problème.
J'ai testé ta solution qui fonctionne elle aussi parfaitement.

Il ne me reste plus qu'à tester vos solutions sur le fichier original qui comporte beaucoup plus d'onglets et des références de colonnes diférentes d'un onglet à l'autre...

Je reviendrai pour vous dire si tout est OK.

Encore merci et bonne journée.

Skud · 7 Octobre 2008

Re : Boucles "imbriquées"...

Me voilà déjà de retour !

Tout d'abord j'ai suivi les conseils d'Hasco et j'ai placé le code dans un module de code général => donc pas de soucis pour utiliser les macros quelque soit l'onglet.

En revanche, les tableaux ne sont pas systématiquement constitués des mêmes colonnes et donc cela décale mes champs de recherches (voir l'onglet "Produit3").
Mais les colonnes dont je dois récupérer le contenu sont toujours présentes et avec le même intitulé quelque soit l'onglet.

J'ai donc tenté d'utiliser :

Set pays = ActiveSheet.Cells.Find("Pays", LookIn:=xlValues, lookat:=xlWhole)

Pour retrouver l'intitulé de ma colonne "Pays" et rechercher la ligne correspondante, avec un "offset" après...mais en vain !

Je suis ouvert à toutes propositions ;-)

porcinet82 · 8 Octobre 2008

Re : Boucles "imbriquées"...

Salut,

Tout d'abord, je pense que lorsque Hasco parlait d'un module général, il pensaist à un module "standard" et non un module de feuille. Pour ajouter un module, sous vba, tu fais Insertion/Module et tu places ton code à cet endroit.

Ensuite, mon code suppose quelques prérequis qui sont que tes entetes de colonnes doivent être en ligne 5 et écris toujours de la même manière (accent compris, la casse n'a pas d'importance).

Voici le code :

Code:

Sub Essai_boucle2()
Dim k As Integer
Dim lot As Integer
Dim bool As Boolean
Dim lig As Integer
Dim num_lot%, code_pf%, pays%, present%, date_fab%, date_peremp%
Application.ScreenUpdating = False
' Recherche des coordonnées des colonnes sur la feuille en cours (je suppose que tu es tjs en ligne 5)
num_lot = ActiveCell.Column
For j = 1 To Range("IV5").End(xlToLeft).Column
    If InStr(1, LCase(Cells(5, j).Value), "code pf") > 0 Then
        code_pf = j
    ElseIf InStr(1, LCase(Cells(5, j).Value), "pays") Then
        pays = j
    ElseIf InStr(1, LCase(Cells(5, j).Value), "présentation") Then
        present = j
    ElseIf InStr(1, LCase(Cells(5, j).Value), "fabrication") Then
        date_fab = j
    ElseIf InStr(1, LCase(Cells(5, j).Value), "péremption") Then
        date_peremp = j
    End If
Next j
lot = ActiveCell.Value
bool = False
With Sheets("Synthèse")
    .Range("D6").ClearContents
    .Range("D10" & ":" & "D103").ClearContents
End With
For k = 6 To Cells(65536, num_lot).End(xlUp).Row
    If Cells(k, num_lot).Value = lot Then
        If bool = False Then
            With Sheets("Synthèse")
                .Range("D6") = Range("D1")
                .Range("D10") = lot
                .Range("D12") = Format(Cells(k, date_fab), "mmm yyyy")
                lig = 16
                bool = True
            End With
        End If
        With Sheets("Synthèse")
            .Range("D" & lig) = Cells(k, pays)
            .Range("D" & lig + 2) = Cells(k, present)
            .Range("D" & lig + 4) = Cells(k, code_pf)
            .Range("D" & lig + 6) = Format(Cells(k, date_peremp), "mmm yyyy")
            lig = lig + 9
        End With
    End If
Next k
Application.ScreenUpdating = True
End Sub

Une autre petite chose, fais attention aux déclarations de variables. Dans ma macro, il y avait la déclaration Dim lot As String alors que je faisais par la suite la comparaison Cells(k, 1).Value = lot dans laquelle Cells(k, 1).Value est une variable numérique, d'ou le soucis !!!!

@+

Skud · 8 Octobre 2008

Re : Boucles "imbriquées"...

Salut Porcinet82,

Merci de continuer à suivre mon problème.

Concernant l'emplacement du code dans un module général, j'ai fait la modif, mais j'ai encore un peu de mal à appréhender pourquoi il est préférable de le placer à cet emplacement.
Hasco m'avait indiqué que les modules de feuille servaient principalement à la gestion d'événements, mais à quoi servent les modules "standard"?
Je vais bosser le sujet pour connaître un peu plus les différentes utilisations de chaque module.

En ce qui concernent les pré-requis dont tu parles ils correspondent exactement à la structure même de mon fichier. Les entêtes sont toujours à la même ligne et les intitulés des colonnes sont identiques.
=> Donc pas de souci.

J'ai testé ton code et là : problème ! Sur l'onglet "Produit1" cela ne fonctionne pas. Alors que sur les 2 autres c'est bon.

Erreur d'exécution '6' : Dépassement de capacité.

La partie du code posant prblm est :

Code:

lot = ActiveCell.Value

Je décide de modifier la déclaration de variable de "lot" en le repassant en : Dim lot As String
Et là tout fonctionne…

Je t'avoue ne pas tout comprendre aux déclarations de variables, je vais donc regarder cela d'un peu plus près.

En tous cas MERCI beaucoup pour ton aide et tes explications.

Bonne journée.

pierrejean · 8 Octobre 2008

Re : Boucles "imbriquées"...

Re

Salut Romain 🙂

Mon code (ne suppose que l'alignement des en-tête de colonne)

Code:

Sub boucle3()
Dim ligne As Integer
Dim n As Integer
Dim achercher As Variant
Dim c As Range
Dim col_lot As Integer
Dim col_PF As Integer
Dim col_Pays As Integer
Dim col_Pres As Integer
Dim col_fab As Integer
Dim col_Per As Integer
Dim lideb As Integer
achercher = ActiveCell
ligne = 16
col_lot = ActiveCell.Column
Set c = ActiveSheet.Cells.Find("Code PF", LookIn:=xlValues, lookat:=xlWhole)
col_PF = c.Column
lideb = c.Row + 1
Set c = ActiveSheet.Cells.Find("Pays", LookIn:=xlValues, lookat:=xlWhole)
col_Pays = c.Column
Set c = ActiveSheet.Cells.Find("Présentation", LookIn:=xlValues, lookat:=xlWhole)
col_Pres = c.Column
Set c = ActiveSheet.Cells.Find("Fabrication", LookIn:=xlValues, lookat:=xlPart)
col_fab = c.Column
Set c = ActiveSheet.Cells.Find("péremption", LookIn:=xlValues, lookat:=xlPart)
col_Per = c.Column
With Sheets("Synthèse")
.Range("D10" & ":" & "D103").ClearContents
.Range("D6") = Range("D1")
.Range("D10") = achercher
End With
For n = lideb To Cells(65536, col_lot).End(xlUp).Row
  If Cells(n, col_lot).Value = achercher Then
     With Sheets("Synthèse")
     .Range("D" & ligne) = Cells(n, col_Pays)
     .Range("D" & ligne + 2) = Cells(n, col_Pres)
     .Range("D" & ligne + 4) = Cells(n, col_PF)
     .Range("D" & ligne + 6) = Cells(n, col_Per)
     .Range("D12") = .Range("D12") & Cells(n, col_fab) & " - "
     End With
     ligne = ligne + 9
  End If
Next n
Sheets("Synthèse").Range("D12") = Left(Sheets("Synthèse").Range("D12"), Len(Sheets("Synthèse").Range("D12")) - 2)
End Sub

Dans le fichier j'ai transféré les 3 macros dans le Module1

Ps: j'ai supposé le nom de produit toujours en D1 (sinon je ne sais pas faire !!)

Skud · 8 Octobre 2008

Re : Boucles "imbriquées"...

Bonjour PierreJean,

Merci à toi aussi de suivre ce fil.

Pour ce qui est de l'alignement des entêtes pas de problème comme je le disais à Porcinet82.
De même l'emplacement du nom du produit est toujours au même endroit donc c'est bon.

J'ai testé ton code et il fonctionne sans souci.

En revanche, pour les 2 codes (celui de PierreJean et celui de Porcinet82) je me trouve face à un problème que je n'avais pas anticipé...

Et je m'en excuse par avance, mais j'ai oublié de préciser que toutes les colonnes ne sont pas forcément présentes... Et donc s'il me manque la colonne date de fabrication par exemple, les 2 macros plantent.

Est-il possible, que dans ce cas d'inscrire : "---" ou "NA" à la place?

pierrejean · 8 Octobre 2008

Re : Boucles "imbriquées"...

Re

Version avec une ou plusieurs colonnes absentes (sauf la colonne Numéro de lot lol !!)

Code:

Sub boucle3()
Dim ligne As Integer
Dim n As Integer
Dim achercher As Variant
Dim c As Range
Dim col_lot As Integer
Dim col_PF As Integer
Dim col_Pays As Integer
Dim col_Pres As Integer
Dim col_fab As Integer
Dim col_Per As Integer
Dim PF_abs As Boolean
Dim Pays_abs As Boolean
Dim Pres_abs As Boolean
Dim fab_abs As Boolean
Dim Per_abs As Boolean
achercher = ActiveCell
ligne = 16
col_lot = ActiveCell.Column
Set c = ActiveSheet.Cells.Find("Code PF", LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
   col_PF = c.Column
Else
   PF_abs = True
End If
Set c = ActiveSheet.Cells.Find("Pays", LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
   col_Pays = c.Column
Else
   Pays_abs = True
End If
Set c = ActiveSheet.Cells.Find("Présentation", LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
   col_Pres = c.Column
Else
   Pres_abs = True
End If
Set c = ActiveSheet.Cells.Find("Fabrication", LookIn:=xlValues, lookat:=xlPart)
If Not c Is Nothing Then
   col_fab = c.Column
Else
   fab_abs = True
End If
Set c = ActiveSheet.Cells.Find("péremption", LookIn:=xlValues, lookat:=xlPart)
If Not c Is Nothing Then
   col_Per = c.Column
Else
   Per_abs = True
End If
With Sheets("Synthèse")
.Range("D10" & ":" & "D103").ClearContents
.Range("D6") = Range("D1")
.Range("D10") = achercher
End With
For n = 6 To Cells(65536, col_lot).End(xlUp).Row
  If Cells(n, col_lot).Value = achercher Then
     With Sheets("Synthèse")
     If Pays_abs Then
     .Range("D" & ligne) = "N/A"
     Else
     .Range("D" & ligne) = Cells(n, col_Pays)
     End If
     If Pres_abs Then
     .Range("D" & ligne + 2) = "N/A"
     Else
     .Range("D" & ligne + 2) = Cells(n, col_Pres)
     End If
     If PF_abs Then
     .Range("D" & ligne + 4) = "N/A"
     Else
     .Range("D" & ligne + 4) = Cells(n, col_PF)
     End If
     If Per_abs Then
     .Range("D" & ligne + 6) = "N/A"
     Else
     .Range("D" & ligne + 6) = Cells(n, col_Per)
     End If
     If fab_abs Then
     .Range("D12") = "N/A"
     Else
     .Range("D12") = .Range("D12") & Cells(n, col_fab) & " - "
     End If
     End With
     ligne = ligne + 9
  End If
Next n
If Not fab_abs Then Sheets("Synthèse").Range("D12") = Left(Sheets("Synthèse").Range("D12"), Len(Sheets("Synthèse").Range("D12")) - 2)
End Sub

A tester bien sur

porcinet82 · 8 Octobre 2008

Re : Boucles "imbriquées"...

re, Salut PierreJean 🙂,

Normalement tous les problèmes sont résolus. J'ai rajouter des controls en cas de colonnes manquantes et pour le string/integer, je passe la variable en string avant la compaison (via CStr), comme ca, on est tranquille.

Code:

Sub Essai_boucle2()
Dim k As Integer
Dim lot As String
Dim bool As Boolean
Dim lig As Integer
Dim num_lot%, code_pf%, pays%, present%, date_fab%, date_peremp%
Application.ScreenUpdating = False
' Recherche des coordonnées des colonnes sur la feuille en cours (je suppose que tu es tjs en ligne 5)
num_lot = ActiveCell.Column
For j = 1 To Range("IV5").End(xlToLeft).Column
    If InStr(1, LCase(Cells(5, j).Value), "code pf") > 0 Then
        code_pf = j
    ElseIf InStr(1, LCase(Cells(5, j).Value), "pays") Then
        pays = j
    ElseIf InStr(1, LCase(Cells(5, j).Value), "présentation") Then
        present = j
    ElseIf InStr(1, LCase(Cells(5, j).Value), "fabrication") Then
        date_fab = j
    ElseIf InStr(1, LCase(Cells(5, j).Value), "péremption") Then
        date_peremp = j
    End If
Next j
lot = ActiveCell.Value
bool = False
With Sheets("Synthèse")
    .Range("D6").ClearContents
    .Range("D10" & ":" & "D103").ClearContents
End With
For k = 6 To Cells(65536, num_lot).End(xlUp).Row
    If CStr(Cells(k, num_lot).Value) = lot Then
        If bool = False Then
            With Sheets("Synthèse")
                .Range("D6") = Range("D1")
                .Range("D10") = lot
                If pays <> 0 Then
                    .Range("D12") = Format(Cells(k, date_fab), "mmm yyyy")
                Else
                    .Range("D12") = "-"
                End If
                lig = 16
                bool = True
            End With
        End If
        With Sheets("Synthèse")
            If pays <> 0 Then
                .Range("D" & lig) = Cells(k, pays)
            Else
                .Range("D" & lig) = "-"
            End If
            If present <> 0 Then
                .Range("D" & lig + 2) = Cells(k, present)
            Else
                .Range("D" & lig + 2) = "-"
            End If
            If code_pf <> 0 Then
                .Range("D" & lig + 4) = Cells(k, code_pf)
            Else
                .Range("D" & lig + 4) = "-"
            End If
            If date_peremp <> 0 Then
                .Range("D" & lig + 6) = Format(Cells(k, date_peremp), "mmm yyyy")
            Else
                .Range("D" & lig + 6) = "-"
            End If
            lig = lig + 9
        End With
    End If
Next k
Application.ScreenUpdating = True
End Sub

@+

Edit : Et bien PierreJean, tu m'as devancé de pas grand chose sur ce coup... 😉

Skud · 8 Octobre 2008

Re : Boucles "imbriquées"...

Merci à vous deux ! ;-)

Je teste cela en début d'après-midi et je reviens vers vous pour vous tenir au courant.

pierrejean · 8 Octobre 2008

Re : Boucles "imbriquées"...

Re

Petite amélioration:

Il est possible dans l'une quelconque des feuilles d'inserer une ou plusieurs lignes au dessus du tableau (seules contraintes : l'alignement des en-têtes et designation des en-têtes toujours identiques)

Boucles "imbriquées"...

Skud

Guest

Pièces jointes

Guest

Guest

porcinet82

XLDnaute Barbatruc

Skud

Guest

pierrejean

XLDnaute Barbatruc

Skud

Guest

Skud

Guest

Pièces jointes

porcinet82

XLDnaute Barbatruc

Skud

Guest

pierrejean

XLDnaute Barbatruc

Pièces jointes

Skud

Guest

pierrejean

XLDnaute Barbatruc

Pièces jointes

porcinet82

XLDnaute Barbatruc

Skud

Guest

pierrejean

XLDnaute Barbatruc

Pièces jointes

Discussions similaires

Boucles "imbriquées"...

Skud

Guest

Pièces jointes

Guest

Guest

porcinet82

XLDnaute Barbatruc

Skud

Guest

pierrejean

XLDnaute Barbatruc

Skud

Guest

Skud

Guest

Pièces jointes

porcinet82

XLDnaute Barbatruc

Skud

Guest

pierrejean

XLDnaute Barbatruc

Pièces jointes

Skud

Guest

pierrejean

XLDnaute Barbatruc

Pièces jointes

porcinet82

XLDnaute Barbatruc

Skud

Guest

pierrejean

XLDnaute Barbatruc

Pièces jointes

Discussions similaires

Privacy & Transparency

Privacy & Transparency