Boucles imbriquées, nombre de boucles variable, possible?

**halaster08** · 13/04/2016, 14h34

Bonjour,

J'essaye actuellement d'améliorer un code existant pour permettre de choisir un nombre variable de critères.
Actuellement j'ai un code pour 1 critère et un autre pour deux critères.
Dans mon code pour deux critères j'ai 2 boucles imbriquées

Code :

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

1
2
3
4
For i = 0 To var.Count - 1
    For j = 0 To var2.Count - 1
    Next j
Next i

Si je veux avoir 3 critères il me faudra alors 3 boucles etc...
D'où ma question, si c'est possible, comment pourrais-je coder pour que le nombre de boucles correspond aux nombres de critères.

J'espère avoir été a peu près clair.
Merci d'avance.

**cerede2000** · 13/04/2016, 14h51

Bonjour à toi,

Avec si peu de code et si peu de précision ça va être extrêmement difficile de te répondre !
Il faut que tu donnes plus de détails sur le traitement à réaliser et que tu dévoile un peu plus ton code.....

**halaster08** · 13/04/2016, 15h44

Envoyé par cerede2000

Bonjour à toi,

Avec si peu de code et si peu de précision ça va être extrêmement difficile de te répondre !
Il faut que tu donnes plus de détails sur le traitement à réaliser et que tu dévoile un peu plus ton code.....

Je veux bien montrer tout le code mais je pense que c'est inutile, le seul souci que je rencontre pour l'adapter à un nombre de paramètre variable c'est les boucles imbriquées, d'où ma question sur ce point précis.
Mais j'aurais peut-être du la posée ailleurs puisque ça touche la programmation en générale et non le VBA

Envoyé par antonysansh

plusieurs fonctions selon le nombre de paramètres et une fonction qui test ce nombre de paramètres et utilise la bonne fonction.

Merci, le problème de cette méthode c'est qu'il faut que je code pour tout les nombres de paramètres possible, j'aurais aimé faire un code qui s'adapte de lui-même pour pouvoir aller en théorie jusqu'à un nombre de paramètre infini.

**antonysansh** · 13/04/2016, 14h54

Bonjour halaster08,

Dans l'idée un truc de ce style :

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
Function Fonction_1_parametre()
    'ta fonction avec 1 boucle
End Function
 
Function Fonction_2_parametres()
    'ta fonction avec 2 boucles
End Function
 
Function Fonction_3_parametres()
    'ta fonction avec 3 boucles
End Function
 
Function Fonction()
    Select Case nb_parametre
        Case 1
            Fonction_1_parametre
        Case 2
            Fonction_2_parametres
        Case 3
            Fonction_3_parametres
    End Select
End Function

plusieurs fonctions selon le nombre de paramètres et une fonction qui test ce nombre de paramètres et utilise la bonne fonction.

**cerede2000** · 13/04/2016, 15h54

Encore une fois !
Sans savoir ce que tu veux faire je ne vois pas comment t'aider !

Parce que en gros la tu nous demande de faire une fonction machin qui traite x paramètres où x est infini (en gros

).
Ok !
Mais que doit faire cette fonction ?
Que contiennent les paramètres ?

**antonysansh** · 13/04/2016, 16h00

Pour faire plusieurs boucles imbriquées, il faut a minima autant d'indices de boucle que de boucles.
Il faut bien les déclarer donc savoir leurs nombre impossible d'écrire une Sub ou Function.

Sauf si tu prévois un nombre de boucles et que certaine iront de 0 à 0 si le paramètre lui correspondant est vide.

Je pense que cerede veut dire que si nous savions ce que fait le code, l'un d'enter nous pourrait avoir une solution sans passer par des boucles.

**halaster08** · 13/04/2016, 16h36

Envoyé par antonysansh

Pour faire plusieurs boucles imbriquées, il faut a minima autant d'indices de boucle que de boucles.
Il faut bien les déclarer donc savoir leurs nombre impossible d'écrire une Sub ou Function.

Bien sur j'y avais pensé, une fois le nombre de parametre connus disons "p" via une boucle, les appeler A1, A2 ..., Ap

Je pense que cerede veut dire que si nous savions ce que fait le code, l'un d'enter nous pourrait avoir une solution sans passer par des boucles.

Oui j'ai bien compris, mais avant de le montrer je voulais savoir si il existait une solution simple à mon problème de boucle, ce qui visiblement n'est pas le cas.

edit: Mais bon si c'est pas faisable, t'as solution est envisageable bien que longue a programmer pour un nombre de paramêtre grand.

**halaster08** · 13/04/2016, 16h28

Envoyé par cerede2000

Encore une fois !
Sans savoir ce que tu veux faire je ne vois pas comment t'aider !

Parce que en gros la tu nous demande de faire une fonction machin qui traite x paramètres où x est infini (en gros

).
Ok !
Mais que doit faire cette fonction ?
Que contiennent les paramètres ?

Bien sur que x est pas infini en vrai, mais j'aimerais juste trouver un moyen de ne pas le borné.
Désolé je suis mathématicien à la base et pas programmeur.
Tout ce que je voulais savoir c'était si il existait une technique pour coder des boucles imbriquées dont le nombre est variable.

Mais puisque tu insiste je vais mettre tout le programme.
Contexte: On me demande souvent de séparer mes tableaux en plusieurs onglets suivant les valeurs de certaines variables.
Du coup j'ai fait plusieurs programmes au fil du temps, en récupérant des bouts de code à droite à gauche, le dernier en date utilisant les filtres avancés.
Souvent je sépare suivant une ou deux colonnes mais on m'a déjà demandé plus, du coup je voudrais réaliser un unique programme qui me demanderait de choisir suivant quelle colonne je voudrait séparer mon fichier.
J'ai donc penser à un userform contenant une listbox remplie par les titres de mes colonnes, je choisi mes colonnes puis je lance la macro.
Mais je suis vite confronté à un problème: mes boucles imbriquées, d'où ma question.
Voici donc l'ébauche du code avec pour l'instant 2 paramè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
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
Private Sub CommandButton1_Click()
 
'cette macro sépare les données ,de la feuille dont le nom est dans la variable data, en une feuille par valeur différentes
'cette macro n'a pas besoin que les données soient triées car elle utilise les filtres avancés.
 
Application.ScreenUpdating = False
Dim FEUILLE_DEST As Worksheet
Dim var As Object
Dim Plage As Range
Dim Cell As Range
Dim i As Long
Data = "RSS_data"
 
' création de l'objet SortedList
Set var = CreateObject("System.Collections.SortedList")
Set var2 = CreateObject("System.Collections.SortedList")
 
'si je passe mon problème de boucle plus bas l'idée est remplir les NomCol via une listbox
Set c = Rows(1).Find("NomCol1", LookIn:=xlValues)
    If Not c Is Nothing Then col1 = c.Column
Set c = Rows(1).Find("NomCol2", LookIn:=xlValues)
    If Not c Is Nothing Then col2 = c.Column
 
With ThisWorkbook.Worksheets(Data).Cells(1, 1)
    Set Plage = .CurrentRegion  ' plage des données (avec les titres)
    For Each Cell In .CurrentRegion.Columns(col1).Cells   ' boucle pour créer la liste sans doublon
        If Not var.containskey(Cell.Value) And Cell.Row > 1 Then
            var.Add Cell.Value, Cell.Text
        End If
    Next Cell
    For Each Cell In .CurrentRegion.Columns(col2).Cells   ' boucle pour créer la liste sans doublon
        If Not var2.containskey(Cell.Value) And Cell.Row > 1 Then
            var2.Add Cell.Value, Cell.Text
        End If
    Next Cell
End With
 
 
For i = 0 To var.Count - 1
    For j = 0 To var2.Count - 1
       ' ici on gère le fait que la feuille existe ou non
       On Error Resume Next
           Set FEUILLE_DEST = ThisWorkbook.Worksheets(var2.getbyindex(j) & "_" & var.getbyindex(i))
       On Error GoTo 0
 
       ' si la feuille n'existe pas : on la crée et la renomme avec le nom de la var
       If FEUILLE_DEST Is Nothing Then
           Set FEUILLE_DEST = ThisWorkbook.Worksheets.Add
           FEUILLE_DEST.Name = var2.getbyindex(j) & "_" & var.getbyindex(i)
           FEUILLE_DEST.Move After:=Sheets(ActiveWorkbook.Sheets.Count)
 
       ' si la feuille existe : on efface tout
       Else
           FEUILLE_DEST.Cells.Clear
       End If
 
       ' utilisation du filtre avancé
       With FEUILLE_DEST
            .Cells(1, 1) = Plage.Cells(1, 1) ' nom du critère (l'entête de la colonne 1)
            .Cells(2, 1) = var.getbyindex(i)            ' valeur du critère : nom de la var (qui est le nom de la feuille)
            .Cells(1, 2) = Plage.Cells(1, 2)
            .Cells(2, 2) = var2.getbyindex(j)
           Plage.AdvancedFilter xlFilterCopy, .Cells(1, 1).CurrentRegion, .Cells(4, 1), False  ' application du filtre avancé
           .Cells(1, 1).Resize(3, 1).EntireRow.Delete ' nettoyage de la zone des critères (= suppression des lignes 1 à 3)
       End With
 
       Set FEUILLE_DEST = Nothing
    Next j
Next i
 
 
'auto ajustement de la taille des colonnes pour plus de lisibilité
For Each sh In ThisWorkbook.Sheets
    sh.Cells.EntireColumn.AutoFit
Next sh
 
Application.ScreenUpdating = True
 
End Sub

**cerede2000** · 13/04/2016, 16h39

Alors, j'ai lu, relut, re-relut et même re-re-relut

Mais je ne comprends pas !

Voici ce que j'ai compris déjà

Donc, tu à un fichier Excel avec un tableau de plusieurs colonnes.
Tu veux extraire une partie des données de ce tableau en filtrant une ou plusieurs colonnes et aller les placer dans une autre feuille.

L'idée est de pouvoir faire une liste de différents filtres, avec des colonnes différentes et des critères différents en une fois et que ça te génère une feuille par filtre ?

Est-ce que j'ai bien compris le besoin ?

**halaster08** · 13/04/2016, 16h46

Oui c'est bien çà, tu vois que c'était clair ...

si j'ai dans ma colonne 1 les valeurs a ou b et dans la colonne 2 les valeurs 1 ou 2.
il filtre et me sort un onglet a1, un onglet a2, b1, b2

Et je voudrais généraliser ça en laissant le choix des colonnes a l'utilisateur, et du coup permettre de choisir plusieurs colonnes

**eriiic** · 13/04/2016, 16h54

Bonjour,

une proposition qui te gère x index qui vont de 0 à ce_que_tu_veux pour chaque index.
Les index sont dans la table tablIdx

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
Sub test()
    Dim tablIdxSupp(), tablIdx(), nbIdx As Long
    Dim i As Long, j As Long, fini As Boolean
    Dim s As String
    nbIdx = 3 ' nombres de boucles imbriquées
    ReDim tablIdxSupp(1 To nbIdx) 'borne supp des boucles
    ReDim tablIdx(1 To nbIdx) ' index des boucles
    'init pour test
    For i = 1 To nbIdx
        tablIdxSupp(i) = 4    ' indices supérieurs des boucles, ici tous égaux
        tablIdx(i) = 0 ' tous les idx à 0
    Next i
 
    Do
        If Not fini Then
            'code pour test
            s = ""
            For i = 1 To nbIdx
                s = s & ", " & tablIdx(i)
            Next i
            Debug.Print s ' valeur des x index pour cette boucle
            ' code réel
            '....
        End If
 
        ' index suivant
        For i = nbIdx To 1 Step -1
            tablIdx(i) = tablIdx(i) + 1
            If tablIdx(1) > tablIdxSupp(1) Then fini = True: Exit For
            If tablIdx(i) > tablIdxSupp(i) Then
                tablIdx(i) = 0
            Else
                Exit For
            End If
        Next i
    Loop Until fini
End Sub

Re,

Réécrit sous une forme un peu différente, avec possibilité de mettre des bornes inférieures aux boucles :

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
Sub test()
    ' remplacer x boucles imbriquées i, j, k, etc
    ' par une boucle unique et des index d'une table tablIdx(x), tablIdx(x-1), ... ,tablIdx(1)
    '
    Dim tablIdx(), tablIdxInf(), tablIdxSup(), nbIdx As Long
    Dim nbBoucle As Currency, boucle As Currency ' (922 337 203 685 477 maxi)
    Dim i As Long
    Dim s As String
 
    nbIdx = 3    ' nombres de boucles imbriquées
    ReDim tablIdx(1 To nbIdx)    ' index des boucles
    ReDim tablIdxInf(1 To nbIdx)    'borne inférieure des boucles
    ReDim tablIdxSup(1 To nbIdx)    'borne supérieure des boucles
 
    ' init
    nbBoucle = 1
    For i = 1 To nbIdx
        'init bornes
        tablIdxInf(i) = 0    ' borne inférieurs des boucles, ici toutes égales
        tablIdxSup(i) = 4    ' borne supérieurs des boucles, ici toutes égales
        ' init Index
        tablIdx(i) = tablIdxInf(i)    ' index i initialisé à sa borne inférieure
        nbBoucle = nbBoucle * (tablIdxSup(i) - tablIdxInf(i) + 1)
    Next i
 
    ' boucle remplaçant x boucles imbriquée
    For boucle = 1 To nbBoucle
        'code pour test
        s = ""
        For i = 1 To nbIdx
            s = s & ", " & tablIdx(i)
        Next i
        Debug.Print Mid(s, 3)
        ' code réel
        '....
 
        ' index suivants
        For i = nbIdx To 1 Step -1
            tablIdx(i) = tablIdx(i) + 1    ' incrémentation de l'index i
            If tablIdx(i) > tablIdxSup(i) Then
                tablIdx(i) = tablIdxInf(i)    'index i réinitialisé à sa borne inférieure
            Else
                Exit For
            End If
        Next i    ' puis incrémentation index précédent
    Next boucle
End Sub

**antonysansh** · 14/04/2016, 08h23

Très jolie eriiic, j'aime l'idée.

J'avais il y a quelque temps fais une macro pour spliter un tableau en autant d'onglet qu'il y a de modalités dans une colonne sélectionnée.

Exemple :
un tableau d'individu avec le sexe en colonne A. Je lance la macro, je sélectionne une cellule de la colonne A.
2 onglets sont créés. Un avec les hommes et l'autre avec les femmes. (de mémoire il n'y a que deux modalités pour le sexe

)

Il y a peut être possibilité de l'adapter pour ton cas. selon le nombre de colonnes c'est juste la construction du dico qui va changer et ensuite les filtres avant suppression.

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
Sub Spliter()
    Dim Dico As Dictionary  'La référence : Microsoft Scripting Runtime doit être activée
    Dim sh As Worksheet
    Dim Rg_Colonne As Range, Tableau As Range
    Dim i&, cle$
 
        Select Case MsgBox("Pour utiliser cette macro, assurez vous que la plage de données commence en [A1]", vbOKCancel + vbCritical, "Fragmenter Tableau")
            Case vbOK
                'la suite apres le select
            Case vbCancel
                GoTo fin
        End Select
 
        Set Dico = New Dictionary
        On Error Resume Next
            Set Rg_Colonne = Application.InputBox(Prompt:="Selectionnez la colonne de critere pour fragmenter le fichier", Title:="Séléction Critere", Type:=8)
        On Error GoTo 0
    Application.ScreenUpdating = False
        If Rg_Colonne Is Nothing Then
            GoTo fin
        End If
        Set Tableau = [A1].CurrentRegion
 
        On Error Resume Next
            For i = 2 To Tableau.SpecialCells(xlCellTypeLastCell).Row
                cle = Cells(i, Rg_Colonne.Column)
                Dico.Add cle, cle
            Next i
        On Error GoTo 0
 
        Set sh = Tableau.Worksheet
        For i = 0 To UBound(Dico.Items)
            If Dico.Items(i) <> "" Then
                sh.Copy After:=sh
                Sheets(sh.Index + 1).Name = Dico.Items(i)
            End If
        Next i
 
        Application.DisplayAlerts = False
            For Each sh In ActiveWorkbook.Worksheets
                If Dico.Exists(sh.Name) Then
                    sh.Select
                    sh.Range(Tableau.Address).AutoFilter Field:=Rg_Colonne.Column, Criteria1:="<>" & sh.Name
                    sh.Range(Tableau.Address).Offset(1, 0).SpecialCells(xlCellTypeVisible, True).Delete
                    sh.ShowAllData
                End If
            Next
        Application.DisplayAlerts = True
fin:
    Application.ScreenUpdating = True
    Set Dico = Nothing
    Set sh = Nothing
    Set Rg_Colonne = Nothing
    Set Tableau = Nothing
End Sub

**halaster08** · 14/04/2016, 13h21

Bonjour,

Merci pour vos réponses.
Je n'ai malheureusement pas beaucoup de temps aujourd'hui je vais donc répondre rapidement

@antonysansh
C'est exactement ce que je fais sauf que là le fait pour 2 colonnes et que justement je voudrait laisser le choix du nombres de colonnes

@ériiic
Merci pour le code, je n'ai pas le temps de le regarder en détails tout de suite, de ce que je vois ça dépasse ce que je sais faire donc il va me falloir un peu de temps et des tests pour bien comprendre comment ça marche.

@cerede2000
c'est toi qui a voulu tout le détail !!
Non dans mon userform je veut juste faire apparaitre la liste des colonne, et on choisit la/les colonnes à partir desquelles on veut split le fichier.
Via cette partie du code:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
With ThisWorkbook.Worksheets(Data).Cells(1, 1)
    Set Plage = .CurrentRegion  ' plage des données (avec les titres)
    For Each Cell In .CurrentRegion.Columns(col1).Cells   ' boucle pour créer la liste sans doublon
        If Not var.containskey(Cell.Value) And Cell.Row > 1 Then
            var.Add Cell.Value, Cell.Text
        End If
    Next Cell
    For Each Cell In .CurrentRegion.Columns(col2).Cells   ' boucle pour créer la liste sans doublon
        If Not var2.containskey(Cell.Value) And Cell.Row > 1 Then
            var2.Add Cell.Value, Cell.Text
        End If
    Next Cell
End With

Il récupère les différentes valeurs de chaque colonne (ici y en a deux mais je peut faire une boucle si j'en selectionne "n", et on les utilises plus loin pour le filtre.

En vrai je ne pense pas avoir a selectionné plus de 4 colonnes (en tout cas c'est le max que j'ai eu a faire pour l'instant) donc je pourrais écrire 4 code simillaires suivant le nombres de colonnes comme proposé plus haut.
Mais comme je suis loin d'être expert en programmation et que j'aime bien progresser, je me demandais s'il était possible de faire un code qui s'adapterais pour "n" colonnes selectionnées. Car sait ça pourrait peut être me servir pour plus tard ou m'aider à améliorer d'autres codes.
Et si j'ai bien compris le code d'éric, je pourrais remplacer mes boucles imbriquées, et donc je devrais pouvoir résoudre mon problème.

Encore une fois merci.

**cerede2000** · 13/04/2016, 16h52

Attends :

si j'ai dans ma colonne 1 les valeurs a ou b et dans la colonne 2 les valeurs 1 ou 2.
il filtre et me sort un onglet a1, un onglet a2, b1, b2

Encore une fois je déchiffre

Dans ton USF, pour ce que tu à écris, tu saisirai quoi ?

Pour moi tu devrai saisir 4 filtre différents :
F1 : C1 => a / C2 => 1
F2 : C1 => a / C2 => 2
F3 : C1 => b / C2 => 1
F4 : C1 => b / C2 => 2

Parce que en ne saisissant qu'un seul filtre :
F: C1 => a OU b / C2 => 1 OU 2

Je ne vois pas comment déterminer le nombre de feuille à sortir.
Car le jour ou tu voudra un seul onglet pour un filtre genre :
F: C1 => b / C2 => 1 OU 2

Comment on fait

Edit : A limite ou pourrait imaginer saisir que deux filtres :
F1 : C1 => a / C2 => 1 OU 2
F3 : C1 => b / C2 => 1 OU 2

Et on fait une décomposition mais bon même problème si tu rajoute un 3ieme niveau genre :
C1 : a OU b / C2 : 1 OU 2 / C3 : 100 ET 500
Toi tu voudrais que ça donne combien de feuille ça ?
a-1-100
a-1-500
a-2-100
a-2-500
b-1-100
b-1-500
b-2-100
b-2-500

Je n'arrive pas à voir le lien entre le nombre de colonnes, de critères et le nombre de feuille que ça doit généré en sortie.
Mais toi qui est mathématicien tu va me dire ça

**cerede2000** · 14/04/2016, 13h43

Ok !
Alors déjà pour récupérer toutes les valeurs unique de chaque colonnes tu pourrait faire en une seule fois avec :

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
Sub test()
    Dim col As Range
    Dim cel As Range
    Dim tabCols()
    Dim dicoCells As Object
 
    ReDim tabCols(1 To ActiveSheet.UsedRange.Columns.Count)
 
    For Each col In ActiveSheet.UsedRange.Columns
        Debug.Print "Column name : " & col.Cells(1, 1).Value
 
        Set dicoCells = CreateObject("Scripting.Dictionary")
 
        Set tabCols(col.Column) = dicoCells
 
        Set col = col.Resize(col.Rows.Count).Offset(1)
        For Each cel In col.Cells
            If Not dicoCells.Exists(cel.Value) Then
                dicoCells.Add cel.Value, cel.Text
            End If
        Next
    Next
End Sub

Tu te retrouve avec un tableau du nombre de colonnes contenant un dictionary de chaque valeurs unique de chaque colonne.

Ensuite il suffit de boucler sur le tableau de colonne puis pour chaque valeur du dictionary de boucler sur les autres colonnes toujours en montant pour ne pas retrouver un croisement de valeur déjà traité.
Parce que finalement ton problème de boucle au départ viens déjà du fait que tu créé une variable par colonne, var, var2, var3....
Alors qu'avec un tableau global qui regroupe tout tu n'as plus ce problème

Comme quoi ça sert d'avoir le détails, car sinon on traite pas le vrai problème

**antonysansh** · 14/04/2016, 15h40

J'ai bidouillé un truc (ça explique la "mocheté" de la chose) pour faire sur plusieurs colonnes le code que j'ai précement posté.

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
Sub Spliter()
    Dim Dico As Dictionary  'La référence : Microsoft Scripting Runtime doit être activée
    Dim sh As Worksheet
    Dim Rg_Colonne As Range, Tableau As Range, c As Range
    Dim i&, j&, cle$, Tbl$
    Dim t$(), t2$()
 
 
        Select Case MsgBox("Pour utiliser cette macro, assurez vous que la plage de données commence en [A1]", vbOKCancel + vbCritical, "Fragmenter Tableau")
            Case vbOK
                'la suite apres le select
            Case vbCancel
                GoTo fin
        End Select
 
        Set Dico = New Dictionary
        On Error Resume Next
            Set Rg_Colonne = Application.InputBox(Prompt:="Selectionnez la colonne de critere pour fragmenter le fichier", Title:="Séléction Critere", Type:=8)
        On Error GoTo 0
    Application.ScreenUpdating = False
        If Rg_Colonne Is Nothing Then
            GoTo fin
        End If
        Tbl = "_"
        For Each c In Rg_Colonne.Cells
            Tbl = Tbl & "_" & c.Column
        Next
        Tbl = Replace(Tbl, "__", "")
        t = Split(Tbl, "_")
        Set Tableau = [A1].CurrentRegion
 
        On Error Resume Next
            For i = 2 To Tableau.SpecialCells(xlCellTypeLastCell).Row
                cle = "_"
                For j = 0 To UBound(t)
                    cle = cle & "_" & Cells(i, Val(t(j)))
                Next j
                cle = Replace(cle, "__", "")
                Dico.Add cle, cle
            Next i
        On Error GoTo 0
 
        Set sh = Tableau.Worksheet
        For i = 0 To UBound(Dico.Items)
            If Dico.Items(i) <> "" Then
                sh.Copy After:=sh
                Sheets(sh.Index + 1).Name = Dico.Items(i)
            End If
        Next i
 
        Application.DisplayAlerts = False
            j = Tableau.SpecialCells(xlCellTypeLastCell).Row
            For Each sh In ActiveWorkbook.Worksheets
                If Dico.Exists(sh.Name) Then
                    sh.Select
                    t2 = Split(sh.Name, "_")
                    For i = 0 To UBound(t2)
                        sh.Range(Tableau.Address).AutoFilter Field:=t(i), Criteria1:="=" & t2(i)
                    Next i
                    For i = j To 2 Step -1
                        If sh.Rows(i).Hidden Then sh.Rows(i).Delete
                    Next i
                    sh.ShowAllData
                End If
            Next
        Application.DisplayAlerts = True
fin:
    Application.ScreenUpdating = True
    Set Dico = Nothing
    Set sh = Nothing
    Set Rg_Colonne = Nothing
    Set Tableau = Nothing
End Sub

Je prendrais le temps demain de le mettre au propre mais l'idée est la.

Dans le dico je récupère les cas différents de filtres sur les colonnes sélectionnées pendant l'exécution de la macro.
Je copie autant de fois que d'éléments dans le dico en suite sur chaque ongle je filtre et supprime les lignes masquées.

J'ai testé sur 3 colonnes de 2 modalités avec tous les cas possible :

A	B	C
0	0	0
0	0	1
0	1	0
0	1	1
1	0	0
1	0	1
1	1	0
1	1	1

J'ai bien 8 onglets (en plus de celui de depart) : 0_0_0, 0_0_1, 0_1_0, ......

**halaster08** · 14/04/2016, 16h32

Merci beaucoup pour le code antonysansh,
Cependant je ne vais pas le regarder pour l'instant, là tu as fait tout le travail pour moi et c'est pas ce que cherchais. C'est un peu pour ça aussi que je voulais pas mettre tout le code au début.
Je voulais essayer de faire mon code à moi au maximum, quitte à foirer lamentablement mais j'aurais au moins essayé.
Mais ne te prives pas de poster la suite, si (ou plutôt quand) je serais bloqué, je serais ravi de piquer ton code

@cerede2000
Je ne suis pas d'accord, avec tout le code tu peut contourner le problème pas le résoudre

De toute façon le vrai problème se trouve entre la chaise et le clavier.

En tout cas merci encore pour votre aide.

Invité · 14/04/2016, 17h46

Bonjour,

Le problème est qu'il est difficile de donner une réponse précise vue que nous ne savons pas ce que son le valeur de recherche dns chaque boucle.

Je peux quand même te dire qu'il doit être possible d'implémenter un fonction qui effectue une boucle sur une occurrence et qui se rappel elle même pour scanner une autre boucle mais il faut connaitre le règles de nommage!

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
funtion multiBoucle(colonne as string,ByVal indx as integer, ByVal ValCherche as string,ByVal RetournCol as string) as String 
Dim Cl as string: Cl=Split(colonne & ";",";")(indx)
Dim T
T=range(cells(2,cl),cells(10,cl)
For i=0 to ubound(T) - 1
  if trim("" & T(i)) = ValCherche Then)
     if ubound(T) = i then multiBoucle=cells(i,RetournCol).value: Exit function
     multiBoucle=multiBoucle(colonne,indx + 1,cells(i,RetournCol).value,Split(colonne & ";",";")(indx + ))
  end if
Next
End function
  Sub test()
Dim colonne as string, indx as integer,  ValCherche as string, RetournCol as string
colonne ="A,B,C" :indx = 0 :ValCherche = "ToTo": RetournCol ="B"
Aa=multiBoucle(colonne,indx ,ValCherche,RetournCol)
End sub

Vite fait comme ça je vois qu'il y a de ajustement a faire mais c'est l'idée!

**eriiic** · 14/04/2016, 17h58

@ériiic
Merci pour le code, je n'ai pas le temps de le regarder en détails tout de suite, de ce que je vois ça dépasse ce que je sais faire donc il va me falloir un peu de temps et des tests pour bien comprendre comment ça marche.

Imaginons 3 boucles imbriquées i, j ,k avec 0 et 1 pour chacune.
Au lieu d'avoir les 3 boucles avec i, j ,k qui prennent pour valeur :
0, 0, 0
0, 0, 1
0, 1, 0
...
tu n'as plus qu'une boucle principale de 2x2x2 pas avec tablIdx(1), tablIdx(2), tablIdx(3)qui prennent pour valeur :
0, 0, 0
0, 0, 1
0, 1, 0
...
Bien sûr avant d'entrer dans la boucle principale il faut lui avoir indiqué le nombre de boucles voulues (nbIdx=3) et les bornes inférieures et supérieures pour chaque boucle (tablIdxInf() et tablIdxSup()
Lance le code et regarde la fenêtre d'exécution, tu comprendras tout de suite.
eric

Boucles imbriquées, nombre de boucles variable, possible?

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager