1. #1
    Membre à l'essai
    Homme Profil pro
    AQSSE
    Inscrit en
    juin 2016
    Messages
    20
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 42
    Localisation : France, Oise (Picardie)

    Informations professionnelles :
    Activité : AQSSE

    Informations forums :
    Inscription : juin 2016
    Messages : 20
    Points : 12
    Points
    12

    Par défaut Boucles imbriquées qui ne tournent pas rond

    Bonsoir à toutes et à tous,

    Je me suis lancé bêtement dans des boucles imbriquées.
    J'ai bien suivi mon petit manuel, mais ça fait 2 jours pleins que je bûche dessus

    la boucle ville fonctionne sans problème, mais je ne passe pas à mon "ATA" suivant je passe directement à ma "cell" suivante et ça plante.
    Je sais déjà que la syntaxe doit arrachée quelques yeux mais bon je suis chimiste ^^

    J'ai 7 cell, 33 ATA 58 ville

    le nombre d'ATA change à chaque cell
    le nombre de ville change à chaque ATA

    et ATA et Ville ne sont pas forcement les mêmes

    Merci 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
    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
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
     
    Dim cell As Range
    Dim ATA As Range
    Dim ville As Range
     
     
    Dim derligana As Long
    derligana = Range("A" & Rows.Count).End(xlUp).Row
     
    'boucle 1
     
    For Each cell In Sheets("ref").Range("A30:A35")
    If cell = "" Then Exit For
    crit = cell.Value
    Sheets("ref").Select
    Range("M20") = cell.Value
    Range("L22:L55").ClearContents
     
    Sheets("analyse").Select
    ActiveSheet.Range("$A$2:$N$" & derligana).AutoFilter Field:=11, Criteria1:=cell
    If Range("Q1").Value = 0 Then GoTo 8
    Range("M2:M" & derligana).SpecialCells(xlVisible).Copy
     
    Sheets("ref").Select
    Range("L22").PasteSpecial Paste:=xlPasteValues
    Range("L22").Select
    Range(Selection, Selection.End(xlDown)).RemoveDuplicates Columns:=1, Header:=xlNo
    ActiveWorkbook.Worksheets("Ref").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Ref").Sort.SortFields.Add Key:=Range("L22"), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("Ref").Sort
            .SetRange Range("L23:L31")
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
            'boucle 2 ATA
     
            For Each ATA In Sheets("ref").Range("L22:L60")
            If ATA = "" Then Exit For
     
            Windows("Aide Maintien Maitre.xlsm").Activate
            Sheets("analyse").Select
            ActiveSheet.Range("$A$2:$N$" & derligana).AutoFilter Field:=13, Criteria1:=ATA
            If Range("Q1").Value = 0 Then Exit For
            Range("C2:C" & derligana).SpecialCells(xlVisible).Copy
     
            Sheets("ref").Select
            Range("K22").Select
            Range(Selection, Selection.End(xlDown)).PasteSpecial Paste:=xlPasteValues
            Range("K22").Select
            Range(Selection, Selection.End(xlDown)).RemoveDuplicates Columns:=1, Header:=xlNo
            Range("K22").Select
            Range(Selection, Selection.End(xlDown)).Select
            ActiveWorkbook.Worksheets("Ref").Sort.SortFields.Clear
            ActiveWorkbook.Worksheets("Ref").Sort.SortFields.Add Key:=Range("K22"), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            With ActiveWorkbook.Worksheets("Ref").Sort
                .SetRange Range("K22:k80")
                .Header = xlNo
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
     
            Workbooks.Open Filename:=Range("A6").Value
            Windows("Aide Maintien Maitre.xlsm").Activate
     
     
                'boucle 3 ville
                For Each ville In Sheets("ref").Range("K22:K80")
                If ville = "" Then Exit For
     
                'Windows(Range("A4").Value).Activate
                Windows("Aide Maintien Maitre.xlsm").Activate
                Sheets("analyse").Select
                ActiveSheet.Range("$A$2:$N$" & derligana).AutoFilter Field:=3, Criteria1:=ville
     
                Sheets("ref").Select
                Windows(Range("A4").Value).Activate
     
                With ActiveWorkbook.Sheets("vierge")
                    .Copy After:=Worksheets("vierge")
                End With
                ActiveSheet.Name = ville
     
                Windows("Aide Maintien Maitre.xlsm").Activate
                Sheets("analyse").Select
     
                Windows("Aide Maintien Maitre.xlsm").Activate
                Sheets("analyse").Select
                Range("A2:D" & derligexim).SpecialCells(xlVisible).Copy
                Sheets("ref").Select
                Windows(Range("A4").Value).Activate
                Range("A7").Select
                Selection.PasteSpecial Paste:=xlPasteValues
     
                Windows("Aide Maintien Maitre.xlsm").Activate
                Sheets("analyse").Select
                Range("G2:G" & derligexim).SpecialCells(xlVisible).Copy
                Sheets("ref").Select
                Windows(Range("A4").Value).Activate
                Range("F7").Select
                Selection.PasteSpecial Paste:=xlPasteValues
     
                Windows("Aide Maintien Maitre.xlsm").Activate
                Sheets("analyse").Select
                Range("H2:H" & derligexim).SpecialCells(xlVisible).Copy
                Sheets("ref").Select
                Windows(Range("A4").Value).Activate
                Range("E7").Select
                Selection.PasteSpecial Paste:=xlPasteValues
     
                Windows("Aide Maintien Maitre.xlsm").Activate
                Sheets("analyse").Select
                Range("L2:L" & derligexim).SpecialCells(xlVisible).Copy
                Sheets("ref").Select
                Windows(Range("A4").Value).Activate
                Range("I7").Select
                Selection.PasteSpecial Paste:=xlPasteValues
     
                Windows("Aide Maintien Maitre.xlsm").Activate
                Sheets("analyse").Select
                Range("J2:J" & derligexim).SpecialCells(xlVisible).Copy
                Sheets("ref").Select
                Windows(Range("A4").Value).Activate
                Range("Q7").Select
                Selection.PasteSpecial Paste:=xlPasteValues
     
                Dim derligaide As Long
                derligaide = Range("A" & Rows.Count).End(xlUp).Row
                If derligaide = 7 Then GoTo 7
     
                Range("G7:H7").Select
                Selection.AutoFill Destination:=Range("G7:H" & derligaide)
     
                Range("J7:L7").Select
                Selection.AutoFill Destination:=Range("J7:L" & derligaide)
     
                Range("P7:T7").Select
                Selection.AutoFill Destination:=Range("P7:T" & derligaide)
     
                Range("V7").Select
                Selection.AutoFill Destination:=Range("V7:V" & derligaide)
     
                'suppression des codes qualification = 0
     
                    macellule = ("J7")
                    Range(macellule).Select
     
                    While ActiveCell <> ""
                        If ActiveCell = 0 Then
                        ActiveCell.EntireRow.Delete
                        Else
                        ActiveCell.Offset(1, 0).Select
                    End If
                    Wend
     
                    'boucle 4
                    MaCellule2 = ("J7")
                    Range(MaCellule2).Select
                    donnee2 = ActiveCell
                    ActiveCell.Offset(1, 0).Select
                        While ActiveCell <> ""
                        If ActiveCell = donnee2 Then
                        ActiveCell.EntireRow.Delete
                        ActiveCell.Offset(-1, 0).Select
                        donnee2 = ActiveCell2
                        ActiveCell.Offset(1, 0).Select
                        Else
                        donnee2 = ActiveCell
                        ActiveCell.Offset(1, 0).Select
                        End If
                        Wend
                    'fin boucle 4
     
                MaCellule2 = ("k7")
                Range(MaCellule2).Select
                donnee2 = ActiveCell
                ActiveCell.Offset(1, 0).Select
     
                While ActiveCell <> ""
     
                If ActiveCell.Offset(0, 1) > 0 Then GoTo 2
     
                If ActiveCell = donnee2 Then
                ActiveCell.EntireRow.Delete
                ActiveCell.Offset(-1, 0).Select
                donnee2 = ActiveCell
                ActiveCell.Offset(1, 0).Select
                Else
    2
                donnee2 = ActiveCell
                ActiveCell.Offset(1, 0).Select
                End If
                Wend
     
                'suite boucle 3
    7
                Next ville
     
     
                'fin boucle 3 enregistrement ATA
                ActiveWorkbook.SaveAs Filename:=ATA.Offset(0, 1).Value
                ActiveWorkbook.Close True
            'suite boucle2
     
            Next ATA
        'suite boucle 1
    8
    Next cell

  2. #2
    Responsable
    Office & Excel

    Avatar de Pierre Fauconnier
    Homme Profil pro
    Formateur et développeur informatique indépendant
    Inscrit en
    novembre 2003
    Messages
    10 879
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : Belgique

    Informations professionnelles :
    Activité : Formateur et développeur informatique indépendant
    Secteur : Enseignement

    Informations forums :
    Inscription : novembre 2003
    Messages : 10 879
    Points : 27 314
    Points
    27 314
    Billets dans le blog
    5

    Par défaut

    Salut.

    Déjà, les Goto 8, c'est un peu pas bien...

    Ensuite, il faudrait que tu expliques ce que tu souhaites réaliser et que tu expliques un peu comment ton classeur est conçu. J'ose imaginer que tu travailles avec X>2003 et que tu as organisé tes données en tableau, par exemple...

    La lecture, rapide, de ton code qui, de ton propre aveu, ne fonctionne pas, n'est pas d'une aide précieuse...
    "Plus les hommes seront éclairés, plus ils seront libres" (Voltaire)
    ---------------
    Vous souhaitez rédiger pour DVP? Contactez-moi
    VBA pour Excel? Pensez D'ABORD en EXCEL avant de penser en VBA...
    Vous avez apprécié l'intervention => Merci pour le
    ---------------

  3. #3
    Membre à l'essai
    Homme Profil pro
    AQSSE
    Inscrit en
    juin 2016
    Messages
    20
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 42
    Localisation : France, Oise (Picardie)

    Informations professionnelles :
    Activité : AQSSE

    Informations forums :
    Inscription : juin 2016
    Messages : 20
    Points : 12
    Points
    12

    Par défaut

    merci pour l’intérêt que tu porte à mon poste
    j'utilise excel 2007 (sp3 pro si besoin)

    pour l'explication j'ai un tableau plusieurs colonnes (17) plein de ligne (220k) pour le plus petit etc....

    en premier lieu je calcul le nombre de fois qu'un groupe de donnée apparaît puis je supprime les doublons....

    tout fonctionnent bien.

    ce que je cherche à faire c'est :

    dans un premier temps filtrer sur mes différentes directions. direction nord pour commencer

    copier les cellules visibles (codes Agents) de cette direction supprimer les doublons trier alphabétiquement.

    re filtrer mon tableau sur chaque Agent

    copier es cellules visibles (les villes) de ce code agent supprimer les doublons trier alphabétiquement.
    (il se peut qu'il n y ai pas de ville, la sa plante car pas de données disponibles)

    ouvrir un autre classeur copier l'onglet "vierge" renommer avec la ville

    mon code fonctionne bien a ce stade.

    une fois fait enregistrer le fichier créé sous le nom maintien direction code agent.xls

    aller sur le code agent suivant recommencer

    une fois que tout les codes agents d'une direction sont faits
    je passe à la direction suivante et c'est repartie.

    comme on peut compter 7 * ? * ? ca va me faire beaucoup de fichier

    pour info je crée des répertoires pour chaque direction donc chaque fichier ATA d'une direction doit aller ce ranger bien gentiment dans son répertoire bien au chaud

    pour les goto c'est ma première boucle imbriquée, celle du milieu marche très bien c'est la première et la deuxième qui pêche

    Mais je suis pas contre de l'aide pour faire propre, comme je disais en filigrane je suis novice et autodidacte sur ce coup

  4. #4
    Membre éprouvé Avatar de mjpmjp
    Homme Profil pro
    Chôme Dur des Ambulances
    Inscrit en
    avril 2012
    Messages
    606
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Hautes Alpes (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Chôme Dur des Ambulances
    Secteur : Santé

    Informations forums :
    Inscription : avril 2012
    Messages : 606
    Points : 944
    Points
    944

    Par défaut

    bonjour,
    à chaque ligne que tu écris , poses toi la question : quelle info çà apporte ?
    @+JP
    Mes contributions
    Form GRAPHIQUE, Gestion des boutons
    Form GRAPHIQUE, Liste Onglet dynamique
    Form GRAPHIQUE, Liste Multi-Colonne et ScrollBar Externe

    Les Gens "Instruit" ont passé leur temps à apprendre ce que les Gens "Intelligent" ont passé leur temps à trouver...(JP)

  5. #5
    Membre habitué
    Homme Profil pro
    Développeur VBA
    Inscrit en
    avril 2017
    Messages
    91
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 45
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : Développeur VBA
    Secteur : Finance

    Informations forums :
    Inscription : avril 2017
    Messages : 91
    Points : 140
    Points
    140

    Par défaut

    copier es cellules visibles (les villes) de ce code agent supprimer les doublons trier alphabétiquement.
    (il se peut qu'il n y ai pas de ville, la sa plante car pas de données disponibles)

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    Sheets("analyse").Select
    ActiveSheet.Range("$A$2:$N$" & derligana).AutoFilter Field:=11, Criteria1:=cell
    Range("M2:M" & derligana).SpecialCells(xlVisible).Copy

    Ça plante parce que tu ne vérifie pas si le filtre a des réponses.
    La solution : se mettre après et faire un end(xlup).row pour obtenir le numéro de la dernière cellule visible non vide. Si elle est différente de 2, c'est que le filtre affiche des lignes.
    pareil après les removeduplicates, vérifier combien de réponse il y a. (s'il n'y a qu'une ligne en réponse et qu'on se met dessus, un end(xldown) amène à la dernière ligne possible du classeur plus d'un million, ça peut fausser un programme ^^).

    Faut se mefier de l'enregistreur de macro, un coup la plage des ata va de L22 à L55, un coup la plage va de L22 à L60 et à un troisième endroit elle va de L23 à L31., Il faut compter le nombre de cellule copiées de l'onglet analyse, ou récupérer la dernière cellule du coller, afin de gérer la plage des ATA.



    la boucle ville fonctionne sans problème, mais je ne passe pas à mon "ATA" suivant je passe directement à ma "cell" suivante et ça plante.
    If Range("Q1").Value = 0 Then GoTo 8
    Avec les infos qu'on a, c'est très difficile de pouvoir faire quelque chose. On ne connait pas la formule qui est dans Q1 et donc on ne peut pas deviner si le traitement se débranche vers 8 ou pas ...
    A mon avis, la boucle qui est sautée, c'est à cause d'un goto qui se fait et du coup amène l’exécution en dehors de la boucle.

    Si Après le coller de analyse, la cellule ref!l22 est vide, on sort de la boucle des ata sans rien y faire. C'est ce que laisse supposer le tri qui commence en l23 mais comme vous dites que la boucle ville se passe bien, le souci doit être plus loin.


    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
            Windows("Aide Maintien Maitre.xlsm").Activate
                Sheets("ref").Select
                Windows(Range("A4").Value).Activate
    [/QUOTE]
    Je vous félicite, c'est très astucieux. Vous vous débrouillez avec ce que vous savez et comprenez, c'est une très bonne façon de commencer. Oser, essayer, et s'ajuster au fur et à mesure.
    D'une façon générale, vous êtes souvent embetté dans votre code parce que vous ne savez pas adresser vos objets. Lisez tranquilement des codes des uns et des autres, des cours, ça va très vite venir.
    je vous propose au début dans vos dim d'ajouter
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    dim fRef as worksheet 'feuille ref
    dim fAnalyse as worksheet
    dim cMacro as workbook 'classeur de la macro
    dim cOuvert as workbook 'classeur de l'agent en cours
    dim fVille as worksheet
    après "Dim derligana As Long"ajouter
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    set cMacro = thisworkbook
    set fRef = cMacro.sheets("ref")
    set fAnalyse = cMacro.sheets("Analyse")
    grace à ca, vous allez pouvoir vous adresser directement à la feuille /au classeur sans avoir besoin de l'activer avant.
    tout ce qui ActiveWorkbook.Worksheets("Ref")., sheets("ref"). pourra être remplacé par fRef.
    CMacro. pourra remplacer tout ce qui est Windows("Aide Maintien Maitre.xlsm").

    Il y a beaucoup de selection, d'activeMachin et biduleTruc. C'est encore trop tôt pour vous passer de tout ce qui est .activate, .select mais ça viendra.
    Vous pouvez commencer à ajouter devant tous vos range quelle est la dernière feuille sélectionnée ou active.

    Tout le pavé
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    Windows("Aide Maintien Maitre.xlsm").Activate
                Sheets("analyse").Select
                Range("A2: D" & derligexim).SpecialCells(xlVisible).Copy
                Sheets("ref").Select
                Windows(Range("A4").Value).Activate
                Range("A7").Select
                Selection.PasteSpecial Paste:=xlPasteValues[/
    peut s'écrire maintenant plus simplement
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
     fAnalyse.Range("A2: D" & derligexim).SpecialCells(xlVisible).Copy
                fville.Range("A7").PasteSpecial Paste:=xlPasteValues
    Pour ce faire, il reste a définir cOuvert et fVilleremplacez "Workbooks.Open Filename:=Range("A6").Value" par "set cOuvert = Workbooks.Open Filename:=fRef.Range("A6").Value"

    remplacez "
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    With ActiveWorkbook.Sheets("vierge")
                    .Copy after:=Worksheets("vierge")
                End With
                ActiveSheet.Name = ville"
    par "set fVille = cOuvert.Sheets("vierge")
    fville.copy after:=fville
    set fville = activesheet
    fville.name = "ville"


    mettez un point d'arrêt sur If ATA = Then Exit For (clic gauche en début de ligne, dans la barre grise pour faire apparaitre un point rouge).
    lancez votre macro. Elle va se dérouler normalement. A un moment, la ligne rouge devrait passer en jaune. Faire 2 fois F8. Si le jaune ne va pas sur le "exit for" faire F5. A chaque fois que le jaune apparait sur le rouge, faire deux fois F8 puis F5.
    la seconde fois que vous verrez le jaune, c'est que la boucle ata fonctionne. Vous pouvez faire pareil sur If Range("Q1").Value = 0 Then Exit For pour voir s'il prend cet exit for là.
    Et aussi sur If derligaide = 7 Then GoTo 7", et sur le goto 2, ....
    remettez votre code une fois que vous l'aurez un peu nettoyé et dites nous où vous en êtes. ce qui fonctionne et ne fonctionne pas, ...
    Je ne teste quasi jamais le code que je propose. il s'agit juste d'indication sur comment je m'y prendrais, comment faire, des lignes d'intention.
    Il y a donc souvent des erreurs, le déboggage existe pour cela.

  6. #6
    Membre à l'essai
    Homme Profil pro
    AQSSE
    Inscrit en
    juin 2016
    Messages
    20
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 42
    Localisation : France, Oise (Picardie)

    Informations professionnelles :
    Activité : AQSSE

    Informations forums :
    Inscription : juin 2016
    Messages : 20
    Points : 12
    Points
    12

    Par défaut

    Gfacro

    Merci effectivement je traîne beaucoup d'enregistreur de macro qui m'aide beaucoup (en tout cas débroussaille pas mal).

    Je vais essayé de réécrire avec vos conseils et je reviens j'espère avec un youpi ^^.

  7. #7
    Membre à l'essai
    Homme Profil pro
    AQSSE
    Inscrit en
    juin 2016
    Messages
    20
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 42
    Localisation : France, Oise (Picardie)

    Informations professionnelles :
    Activité : AQSSE

    Informations forums :
    Inscription : juin 2016
    Messages : 20
    Points : 12
    Points
    12

    Par défaut

    Bonjour,

    J'ai réussi à faire tourner mes boucles, en réinitialisant mes colonnes ATA et Ville à chaque changement de Direction puis ma colonne ville à chaque changement d'ATA.

    J'ai voulu faire
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    dim cOuvert as workbook 'classeur de l'agent en cours
    set cOuvert = Workbooks.Open Filename:=fRef.Range("A6").Value
    mais j'ai un message d'erreur sur le Filename "erreur de compilation : attendu : fin d'instruction"

    Voici mon code (perfectible encore je sais), mais à priori il fonctionne bien

    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
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
     
    For Each Cell In fRef.Range("A30:A35")
    If Cell = "" Then Exit For
    fRef.Select
    Range("M20").ClearContents
    Range("M20") = Cell.Value
    Range("L:L").ClearContents
     
    fAnalyse.Range("$A$2:$N$" & derligana).AutoFilter Field:=11, Criteria1:=Cell
    fAnalyse.Select
    fAnalyse.Range("$A$2:$N$" & derligana).AutoFilter Field:=3, Criteria1:="<>"""
    fAnalyse.Range("$A$2:$N$" & derligana).AutoFilter Field:=13, Criteria1:="<>"""
    Range("M2:M" & derligana).SpecialCells(xlVisible).Copy
     
    fRef.Select
    Range("L22").Select
    Selection.PasteSpecial Paste:=xlPasteValues
     
    derata = Range("l" & Rows.Count).End(xlUp).Row
     
    Range("L22:l" & derata).RemoveDuplicates Columns:=1, Header:=xlNo
    fRef.Sort.SortFields.Clear
    fRef.Sort.SortFields.Add Key:=Range("L22"), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With fRef.Sort
            .SetRange Range("L22:L" & derata)
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
     
            'boucle 2 ATA
     
            For Each ATA In fRef.Range("L22:L" & derata)
            If ATA = "" Then Exit For
            fAnalyse.Range("$A$2:$N$" & derligana).AutoFilter Field:=13, Criteria1:=ATA
            'If Range("A" & Rows.Count).End(xlUp).Row < 2 Then GoTo 8
            fAnalyse.Range("$A$2:$N$" & derligana).AutoFilter Field:=3, Criteria1:="<>"""
            fAnalyse.Select
            Range("C2:C" & derligana).SpecialCells(xlVisible).Copy
     
            ATAVILLE = ATA.Offset(0, 1).Value
     
            cMacro.Activate
            fRef.Select
            Range("K22").Select
            Selection.PasteSpecial Paste:=xlPasteValues
            derville = Range("k" & Rows.Count).End(xlUp).Row
     
            Range("K22").Select
            Range("K22:k" & derville).RemoveDuplicates Columns:=1, Header:=xlNo
            fRef.Sort.SortFields.Clear
            fRef.Sort.SortFields.Add Key:=Range("K22"), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            With fRef.Sort
                .SetRange Range("K22:k" & derville)
                .Header = xlNo
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
     
           derville = Range("k" & Rows.Count).End(xlUp).Row
     
                Workbooks.Open Filename:=Range("A6").Value
     
                cMacro.Activate
     
                'boucle 3 ville
                For Each Ville In fRef.Range("K22:K" & derville)
                If Ville = "" Then Exit For
                fAnalyse.Range("$A$2:$N$" & derligana).AutoFilter Field:=3, Criteria1:=Ville
     
                cMacro.Activate
                fRef.Select
                Windows(Range("A4").Value).Activate
     
                'cOuvert.Activate
     
                With ActiveWorkbook.Sheets("vierge")
                    .Copy After:=Worksheets("vierge")
                End With
                ActiveSheet.Name = Ville
     
                cMacro.Activate
                fAnalyse.Range("A2:D" & derligexim).SpecialCells(xlVisible).Copy
                fRef.Select
                Windows(Range("A4").Value).Activate
                Range("A7").Select
                Selection.PasteSpecial Paste:=xlPasteValues
     
                cMacro.Activate
                fAnalyse.Range("G2:G" & derligexim).SpecialCells(xlVisible).Copy
                fRef.Select
                Windows(Range("A4").Value).Activate
                Range("F7").Select
                Selection.PasteSpecial Paste:=xlPasteValues
     
                cMacro.Activate
                fAnalyse.Range("H2:H" & derligexim).SpecialCells(xlVisible).Copy
                fRef.Select
                Windows(Range("A4").Value).Activate
                Range("E7").Select
                Selection.PasteSpecial Paste:=xlPasteValues
     
                cMacro.Activate
                fAnalyse.Range("L2:L" & derligexim).SpecialCells(xlVisible).Copy
                fRef.Select
                Windows(Range("A4").Value).Activate
                Range("I7").Select
                Selection.PasteSpecial Paste:=xlPasteValues
     
                cMacro.Activate
                fAnalyse.Range("J2:J" & derligexim).SpecialCells(xlVisible).Copy
                fRef.Select
                Windows(Range("A4").Value).Activate
                Range("Q7").Select
                Selection.PasteSpecial Paste:=xlPasteValues
     
                derligaide = Range("A" & Rows.Count).End(xlUp).Row
                If derligaide = 7 Then GoTo 7
     
                Range("G7:H7").AutoFill Destination:=Range("G7:H" & derligaide)
     
                Range("J7:L7").AutoFill Destination:=Range("J7:L" & derligaide)
     
                Range("P7:T7").AutoFill Destination:=Range("P7:T" & derligaide)
     
                Range("V7").AutoFill Destination:=Range("V7:V" & derligaide)
     
                'suppression des codes qualifications = 0
     
                    macellule = ("J7")
                    Range(macellule).Select
     
                    While ActiveCell <> ""
                        If ActiveCell = 0 Then
                        ActiveCell.EntireRow.Delete
                        Else
                        ActiveCell.Offset(1, 0).Select
                    End If
                    Wend
     
                    'boucle 4
                    MaCellule2 = ("J7")
                    Range(MaCellule2).Select
                    donnee2 = ActiveCell
                    ActiveCell.Offset(1, 0).Select
                        While ActiveCell <> ""
                        If ActiveCell = donnee2 Then
                        ActiveCell.EntireRow.Delete
                        ActiveCell.Offset(-1, 0).Select
                        donnee2 = ActiveCell2
                        ActiveCell.Offset(1, 0).Select
                        Else
                        donnee2 = ActiveCell
                        ActiveCell.Offset(1, 0).Select
                        End If
                        Wend
                    'fin boucle 4
     
                MaCellule2 = ("k7")
                Range(MaCellule2).Select
                donnee2 = ActiveCell
                ActiveCell.Offset(1, 0).Select
     
                While ActiveCell <> ""
     
                If ActiveCell.Offset(0, 1) > 0 Then GoTo 2
     
                If ActiveCell = donnee2 Then
                ActiveCell.EntireRow.Delete
                ActiveCell.Offset(-1, 0).Select
                donnee2 = ActiveCell
                ActiveCell.Offset(1, 0).Select
                Else
    2
                donnee2 = ActiveCell
                ActiveCell.Offset(1, 0).Select
                End If
                Wend
     
                'suite boucle 3
    7
                Next Ville
     
               'fin boucle 3 enregistrement fichier ATA
                cMacro.Activate
                fRef.Select
                Windows(Range("A4").Value).Activate
     
     
                ActiveWorkbook.SaveAs Filename:=ATAVILLE
                Windows(ATA.Offset(0, 2).Value).Close True
            'suite boucle2
    '8
            Next ATA
        'suite boucle 1
     
    Next Cell
    J'obtiens tous mes fichiers au bon endroit sur mon échantillon (30k lignes tout de même)
    il va falloir que je m'attaque à mon vrai fichier (440k de lignes).
    Je pense que mon essai taille réelle va être long.

    Merci encore.

    Je vais maintenant appliquer tes conseils sur mes autres projets.

  8. #8
    Membre habitué
    Homme Profil pro
    Développeur VBA
    Inscrit en
    avril 2017
    Messages
    91
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 45
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : Développeur VBA
    Secteur : Finance

    Informations forums :
    Inscription : avril 2017
    Messages : 91
    Points : 140
    Points
    140

    Par défaut

    cOuvert = Workbooks.Open Filename:=fRef.Range("A6").Value

    Je n'ai peut être pas le bon vocabulaire mais le souci, c'est que l'ouverture de fichier effectue deux instructions en même temps, excel refuse (il faut une instruction par ligne de code).

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    cOuvert = Workbooks.Open( Filename:=fRef.Range("A6").Value
    set cOuvert = activeWorkbooks
    ou
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    cOuvert = Workbooks.Open(Filename:=fRef.Range("A6").Value)
    ou (pareil avec argument non nommé, mais comme c'est le premier, c'est bon)
    cOuvert = Workbooks.Open(fRef.Range("A6").Value

    Je n'ai pas lu tout le code, mais félicitation. Ce n'est pas si évident les boucles. La chose très importante avec, et très délicate, c'est la sortie, la fin de boucle.
    En général, on gère bien le début, le premier tour, mais pour le dernier, on a souvent du mal à savoir si l'on a fait le dernier tour qu'on souhaite ou pas. Et bien entendu, ne pas oublier de faire évoluer la condition de sortie à chaque tour de boucle pour qu'à un moment elle s'arrête.


    **** la boucle 4 ******
    Pensez à utiliser option explicit pour vous forcer à déclarer vos variables et à savoir à quoi elles vous servent. PLorsque vous faites apppel à des objets, forcez-vous à précisez les propriétés des objets auxquelles vous faites appel. Sinon votre code sera nébuleux. "if activeCell.value = donees2.value then"
    Vous utilisez maCellule, maCellule2, donnees2, je suis convaincu que vous n'avez pas réfléchi à ce que sont ces variables, à leurs utilité, ... Déja, le nom des deux premières ne reflète pas leur réalité, elles devraient être mon AdresseDeCellule et donnees2 aurait pu être celluleDeRéférence.

    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
                    'boucle 4
                    MaCellule2 = ("J7")
                    Range(MaCellule2).Select
                    donnee2 = ActiveCell
                    ActiveCell.Offset(1, 0).Select
                        While ActiveCell <> ""
                        If ActiveCell = donnee2 Then
                        ActiveCell.EntireRow.Delete
                        ActiveCell.Offset(-1, 0).Select
                        donnee2 = ActiveCell2
                        ActiveCell.Offset(1, 0).Select
                        Else
                        donnee2 = ActiveCell
                        ActiveCell.Offset(1, 0).Select
                        End If
                        Wend
                    'fin boucle 4
    peut être remplacé par
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    dim maCellule as range
    set maCellule = range("J7")
    While maCellule.value <> ""
        if maCellule.value = maCellule.offset(1,0).value then 
            maCellule.offset(1,0).EntireRow.Delete
        else
             set  maCellule = maCellule.offset(1,0)
        end if
    wend
    Personnnellement, je n'ai jamais eu besoin d'effacer la ligne de ma variable range (ActiveCell.EntireRow.Delete), j'ai toujours supprimé la/les ceullule/s d'à côté. C'est toujours très risqué en programmation de supprimer la cellule active, la ligne active. On se plante souvent ensuite lorsqu'on fait ça.
    Je ne teste quasi jamais le code que je propose. il s'agit juste d'indication sur comment je m'y prendrais, comment faire, des lignes d'intention.
    Il y a donc souvent des erreurs, le déboggage existe pour cela.

  9. #9
    Membre habitué
    Homme Profil pro
    Développeur VBA
    Inscrit en
    avril 2017
    Messages
    91
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 45
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : Développeur VBA
    Secteur : Finance

    Informations forums :
    Inscription : avril 2017
    Messages : 91
    Points : 140
    Points
    140

    Par défaut

    Citation Envoyé par Gfacro Voir le message
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    cOuvert = Workbooks.Open Filename:=fRef.Range("A6").Value
    Je n'ai peut être pas le bon vocabulaire mais le souci, c'est que l'ouverture de fichier effectue deux instructions en même temps, excel refuse (il faut une instruction par ligne de code).

    cOuvert = Workbooks.Open( Filename:=fRef.Range("A6").Value
    set cOuvert = activeWorkbooks

    ou
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    cOuvert = Workbooks.Open(Filename:=fRef.Range("A6").Value)
    ou (pareil avec argument non nommé, mais comme c'est le premier, c'est bon)
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    cOuvert = Workbooks.Open(fRef.Range("A6").Value
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    Workbooks.Open Filename:=fRef.Range("A6").Value
    set cOuvert = activeWorkbooks

    mon erreur. Copier coller que j ai oublié d adapter
    Je ne teste quasi jamais le code que je propose. il s'agit juste d'indication sur comment je m'y prendrais, comment faire, des lignes d'intention.
    Il y a donc souvent des erreurs, le déboggage existe pour cela.

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. une boucle for qui ne fonctionne pas
    Par piffeo dans le forum JavaScript
    Réponses: 3
    Dernier message: 06/11/2008, 21h52
  2. [XSLT] Boucles imbriquées qui ne marchent pas :s
    Par Fatjo dans le forum XSL/XSLT/XPATH
    Réponses: 4
    Dernier message: 11/10/2007, 10h35
  3. [Système] bbcode imbriqué qui ne marche pas
    Par jexl dans le forum Fonctions
    Réponses: 11
    Dernier message: 22/06/2007, 12h21
  4. Listes imbriquées qui ne marchent pas
    Par Faboul dans le forum Access
    Réponses: 16
    Dernier message: 26/01/2007, 10h45
  5. boucle for qui ne marche pas
    Par babastutz dans le forum Syntaxe
    Réponses: 16
    Dernier message: 12/06/2006, 10h59

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo