Répartition données dans plusieurs cellules sous conditions

**shipuden64** · 30/03/2015, 12h13

Bonjour à vous tous,
Je vous contact car je n'arrive plus à avancer sur une macro qui me permet de répartir des données sur plusieurs cellules.
Je m'explique : dans un tableau2 j'ai toutes les semaines de l'année et pour chaque semaine j'ai la quantitée de produit à produire. La macro que j'essaie de construire me permet de completer mon tableau1 (colonne G) et pour chaque produit dans la semaine désirée lui imputer la date de production.
Voici un petit bout de mon code et en pj mon fichier pour mieux me comprendre.

Code :

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

1
2
3
4
5
6
7
8
Sub date_prod()
Dim i As Integer
For i = 2 To 500 Step 1
If Sheets("Tableau1").Range("F" & i) = Sheets("Tableau2").Range("A" & i) Then
    Sheets("Tableau1").Range("G" & i) = Sheets("Tableau2").Range("D" & i)
End If
Next i
End Sub

Je vous remercie par avance

**joe.levrai** · 30/03/2015, 12h28

Bonjour,

j'ai un peu de mal à comprendre comment doit s'effectuer le repérage dans ton tableau 2, afin de compléter le tableau 1 :

- ton tableau 1 dispose du champs "Code produit", contrairement à ton tableau 2
- dans ta macro, tu veux récupérer la date en colonne D, qui correspond à la date du champs "LUNDI", il ne faut donc pas tenir compte des autres jours de la semaine ?

En fait, ton problème souffre d'un manque de clarté : ce remplissage correspond à quel besoin exactement ?
Car la structure du fichier me semble inadaptée avec les faibles informations fournies, et sources d'erreurs d'interprétation

**shipuden64** · 30/03/2015, 14h00

Merci à toi de prendre le temps de me répondre. Je pense que ce que je désire faire n'est peut être pas faisable. Je vais essayer d'être plus claire.
Dans mon cas de figure on ne tient pas compte du code produit on prend simplement en compte le numéro de semaine. En fonction de ce numero de semaine on va chercher dans le tableau2 la date de production (colonne D, F, H, J, L).
Par exemple pour la semaine 14 j'ai 8 produits à produire (peu importe le code produit). Dans le tableau2 j'ai donc, 2 produits pour lundi, 2 produits pour mardi, 2 produits pour mercredi, 1 produit pour jeudi et 1 pour vendredi.
Ce que je souhaite faire c'est dans le tableau1 renseigner les dates de production calculées dans le tableau2 :

MOIS	Code lancement	Code produit	Date liv.	Date com.	SEM DDO	Date prod.
4	6610	NA28008-016	1/4/2015	27/03/2015	14	30/03/2015
4	6613	NA28012-016	1/4/2015	27/03/2015	14	30/03/2015
4	6624	NA28003-016	2/4/2015	30/03/2015	14	31/03/2015
4	6615	NA28008-016	2/4/2015	30/03/2015	14	31/03/2015
4	6616	NA28008-016	3/4/2015	02/04/2015	14	01/04/2015
4	6617	NA28008-016	7/4/2015	02/04/2015	14	01/04/2015
4	6618	NA28012-016	8/4/2015	03/04/2015	14	02/04/2015
4	6626	NA28008-016	9/4/2015	08/04/2015	14	03/04/2015

**Philippe Tulliez** · 30/03/2015, 14h42

Bonjour,
En résumé, tu souhaites extraire toutes les lignes d'enregistrements d'un tableau "source" vers une plage de données "cible" et ce suivant un ou des critères, comme l'indique le titre de la discussion ?
Si c'est bien le cas, le filtre avancé d'excel est la solution (en VBA, c'est la méthode AdvancedFilter).
A lire Les filtres avancés ou élaborés dans Excel

**joe.levrai** · 30/03/2015, 14h55

Voici une piste sans utilisation des filtres avancés, pour lesquels je n'ai pas encore eu le temps d'en appréhender le fonctionnement.

Il faut adapter à ton cas, j'ai commenté les étapes pour la compréhension.
Le code est fonctionnel sur le fichier que tu as fourni.

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
 
Option Explicit
 
Sub date_prod()
 
    Dim i As Integer
    Dim j As Integer
    Dim ShSource As Worksheet
    Dim ShDest As Worksheet
    Dim CellSource As Range
    Dim CellDest As Range
    Dim Reponse As String
 
    ' récupération du numéro de semaine
    ' attention à prévoir la vérification que la réponse est bien un numéro de semaine
    ' et gérer le cas où l'utilisateur ferme l'invite ou annule l'invite
    Reponse = InputBox("Veuillez indiquer le numéro de semaine")
 
    ' mise sous variable des deux feuilles
    With ThisWorkbook
 
        Set ShSource = .Worksheets("Tableau2")
        Set ShDest = .Worksheets("Tableau1")
 
    End With
 
    ' on cherche la ligne du tableau 2 qui contient le numéro de semaine
    ' on positionne CellSource sur la colonne A de cette ligne
    For i = 2 To ShSource.UsedRange.Rows.Count
        If ShSource.Range("A" & i) = Reponse Then
 
            Set CellSource = ShSource.Range("A" & i)
            Exit For
 
        End If
    Next i
 
    ' gestion du cas où cette semaine n'existe pas dans tableau 2
    If CellSource Is Nothing Then
 
        MsgBox ("La semaine " & Reponse & " n'existe pas dans Tableau2")
        Exit Sub
 
    End If
 
    ' on cherche la première ligne de tableau 1 qui contient ce numéro de semaine
    For i = 2 To ShDest.UsedRange.Rows.Count
        If ShDest.Range("F" & i) = Reponse Then
 
            Set CellDest = ShDest.Range("F" & i)
            Exit For
 
        End If
    Next i
 
    ' gestion du cas où cette semaine n'existe pas dans tableau 1
    If CellDest Is Nothing Then
 
        MsgBox ("La semaine " & Reponse & " n'existe pas dans Tableau1")
        Exit Sub
 
    End If
 
    ' pour les 5 jours de la semaine
    For i = 2 To 10 Step 2
 
        ' on boucle autant de fois que le nombre de pièces à produire sur cette journée
        For j = 0 To CellSource.Offset(0, i) - 1
 
            ' on écrit la date de production sur les "j" lignes de tableau 1
            CellDest.Offset(j, 1) = CDate(CellSource.Offset(0, i + 1))
 
        Next j
 
        ' après avoir fini le traitement de la journée, on décale la ligne d'écrite dans tableau2
        Set CellDest = CellDest.Offset(CellSource.Offset(0, i), 0)
 
    Next i
 
    Set CellDest = Nothing
    Set CellSource = Nothing
    Set ShDest = Nothing
    Set ShSource = Nothing
 
End Sub

**Marc-L** · 30/03/2015, 14h59

Bonjour,

avec un filtre avancé, en général il ne faut guère plus de dix lignes de code …
Sans compter sa célérité : résultat instantané !

__________________________________________________________________________________________________
Je suis Charlie - Je suis Bardo

**shipuden64** · 30/03/2015, 17h19

Je suis en train de tester avec les filtres avancés pour voir si je peux avoir le résultat souhaité sans passer par vb si cela est possible.
Je te remercie pour ta proposition. Je reviens vers vous après quelques tests qui je l'espère seront concluant

Après quelques tests je vais finalement opter pour le code de joe.levrai. En effet, le filtre avancé m’a causé bien des soucis. Cependant, j’ai juste une question concernant la macro j’ai essayé de la remodifier pour le cas où les semaines ne serait pas dans l’ordre croissant mais cela ne fonctionne pas. Exemple ci-dessous :

MOIS	Code lancement	Code produit	Date liv.	Date com.	SEM DDO	Date prod.
4	6610	NA28008-016	1/4/2015	27/03/2015	14
4	6623	NA28008-016	9/4/2015	06/04/2015	15
4	6618	NA28012-016	8/4/2015	03/04/2015	17
4	6625	NA28012-016	10/4/2015	07/04/2015	15
4	6616	NA28008-016	3/4/2015	02/04/2015	14
4	6637	NA28008-016	16/4/2015	15/04/2015	16
4	6625	NA28012-016	10/4/2015	07/04/2015	15
4	6626	NA28008-016	9/4/2015	08/04/2015	14
4	6623	NA28008-016	9/4/2015	06/04/2015	15

Merci

**joe.levrai** · 30/03/2015, 17h33

oui j'ai pris pour postulat que les semaines sont triées, comme dans ton fichier.

dès que j'ai 2 minutes je t'ajoutes en début de procédure un petit classement des lignes de tableau 1, pour avoir tes semaines dans l'ordre (et groupées)

**shipuden64** · 31/03/2015, 09h59

J'ai essayé de t'anticiper (ce qui dans mon cas est inutile je pense

), et j'ai voulu mettre un filtre à l'ouverture du fichier pour qu'il n'y ai pas besoin de changer ta macro mais le filtre ne fonctionne pas :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub Workbook_Open()
Sheets("Tableau1").AutoFilter.Sort.SortFields.Clear
With Sheets("Tableau1")
    .AutoFilter.Sort.SortFields.Add Key:=Range("F1:F1000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
    With Sheets("Tableau1").AutoFilter.Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
    End With
End With
End Sub

Je pense que je vais encore vous embêter. J'ai modifié mon fichier pour qu'il puisse prendre en compte les jours fériés et j'ai donc modifié la macro pour prendre en compte ces modifications sauf que maintenant la macro n'arrive plus à prendre en ccompte les numéros semaines de 1 à 9 et je n'arrive pas à mettre le doigt dessus.

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
Option Explicit
 
Sub date_prod()
Sheets("Tableau1").AutoFilter.Sort.SortFields.Clear
Sheets("Tableau1").AutoFilter.Sort.SortFields.Add Key:=Range("F1:F1000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
    With Sheets("Tableau1").AutoFilter.Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
    End With
 
    Dim i As Integer
    Dim j As Integer
    Dim ShSource As Worksheet
    Dim ShDest As Worksheet
    Dim CellSource As Range
    Dim CellDest As Range
    Dim Reponse As String
 
    ' récupération du numéro de semaine
    ' attention à prévoir la vérification que la réponse est bien un numéro de semaine
    ' et gérer le cas où l'utilisateur ferme l'invite ou annule l'invite
    Reponse = InputBox("Veuillez indiquer le numéro de semaine")
 
    ' mise sous variable des deux feuilles
    With ThisWorkbook
 
        Set ShSource = .Worksheets("Tableau2")
        Set ShDest = .Worksheets("Tableau1")
 
    End With
 
    ' on cherche la ligne du tableau 2 qui contient le numéro de semaine
    ' on positionne CellSource sur la colonne A de cette ligne
    For i = 37 To ShSource.UsedRange.Rows.Count
        If ShSource.Range("A" & i) = Reponse Then
 
            Set CellSource = ShSource.Range("A" & i)
            Exit For
 
        End If
    Next i
 
    ' gestion du cas où cette semaine n'existe pas dans tableau 2
    If CellSource Is Nothing Then
 
        MsgBox ("La semaine " & Reponse & " n'existe pas dans le tableau des quantités")
        Exit Sub
 
    End If
 
    ' on cherche la première ligne de tableau 1 qui contient ce numéro de semaine
    For i = 2 To ShDest.UsedRange.Rows.Count
        If ShDest.Range("F" & i) = Reponse Then
 
            Set CellDest = ShDest.Range("F" & i)
            Exit For
 
        End If
    Next i
 
    ' gestion du cas où cette semaine n'existe pas dans tableau 1
    If CellDest Is Nothing Then
 
        MsgBox ("La semaine " & Reponse & " n'existe pas dans le tableau")
        Exit Sub
 
    End If
 
    ' pour les 5 jours de la semaine
    For i = 10 To 15 Step 1
 
        ' on boucle autant de fois que le nombre de pièces à produire sur cette journée
        For j = 0 To CellSource.Offset(0, i)
 
            ' on écrit la date de production sur les "j" lignes de tableau 1
            CellDest.Offset(j, 1) = CDate(CellSource.Offset(0, i))
        Next j
 
        ' après avoir fini le traitement de la journée, on décale la ligne d'écrite dans tableau2
        Set CellDest = CellDest.Offset(CellSource.Offset(0, i), 0)
 
    Next i
 
    Set CellDest = Nothing
    Set CellSource = Nothing
    Set ShDest = Nothing
    Set ShSource = Nothing
End Sub

**joe.levrai** · 31/03/2015, 10h05

Bonjour,

je te laisse tester, je n'ai pas Excel sous la main là

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
 
Sub date_prod()
 
    Dim i As Integer
    Dim j As Integer
    Dim ShSource As Worksheet
    Dim ShDest As Worksheet
    Dim CellSource As Range
    Dim CellDest As Range
    Dim Reponse As String
    Dim DerLig As Long
 
    ' récupération du numéro de semaine
    ' attention à prévoir la vérification que la réponse est bien un numéro de semaine
    ' et gérer le cas où l'utilisateur ferme l'invite ou annule l'invite
    Reponse = InputBox("Veuillez indiquer le numéro de semaine")
 
    ' mise sous variable des deux feuilles
    With ThisWorkbook
 
        Set ShSource = .Worksheets("Tableau2")
        Set ShDest = .Worksheets("Tableau1")
 
    End With
 
    DerLig = ShDest.UsedRange.Rows.Count
 
    ' tri ascendant de la colonne
    With ShDest.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("F1", "F" & DerLig), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("A1", "G" & DerLig)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
    ' on cherche la ligne du tableau 2 qui contient le numéro de semaine
    ' on positionne CellSource sur la colonne A de cette ligne
    For i = 2 To DerLig
        If ShSource.Range("A" & i) = Reponse Then
 
            Set CellSource = ShSource.Range("A" & i)
            Exit For
 
        End If
    Next i
 
    ' gestion du cas où cette semaine n'existe pas dans tableau 2
    If CellSource Is Nothing Then
 
        MsgBox ("La semaine " & Reponse & " n'existe pas dans Tableau2")
        Exit Sub
 
    End If
 
    ' on cherche la première ligne de tableau 1 qui contient ce numéro de semaine
    For i = 2 To DerLig
        If ShDest.Range("F" & i) = Reponse Then
 
            Set CellDest = ShDest.Range("F" & i)
            Exit For
 
        End If
    Next i
 
    ' gestion du cas où cette semaine n'existe pas dans tableau 1
    If CellDest Is Nothing Then
 
        MsgBox ("La semaine " & Reponse & " n'existe pas dans Tableau1")
        Exit Sub
 
    End If
 
    ' pour les 5 jours de la semaine
    For i = 2 To 10 Step 2
 
        ' on boucle autant de fois que le nombre de pièces à produire sur cette journée
        For j = 0 To CellSource.Offset(0, i) - 1
 
            ' on écrit la date de production sur les "j" lignes de tableau 1
            CellDest.Offset(j, 1) = CDate(CellSource.Offset(0, i + 1))
 
        Next j
 
        ' après avoir fini le traitement de la journée, on décale la ligne d'écrite dans tableau2
        Set CellDest = CellDest.Offset(CellSource.Offset(0, i), 0)
 
    Next i
 
    Set CellDest = Nothing
    Set CellSource = Nothing
    Set ShDest = Nothing
    Set ShSource = Nothing
 
End Sub

**shipuden64** · 31/03/2015, 10h20

Merci à toi le tri marche parfait. Par contre étant donnée que j'ai revu la structure du tableau pour faciliter mes formules j'ai décalé les dates dans les dernières colonnes du tableau2 :

Semaine	Quantité	Lundi	Mardi	Mercredi	Jeudi	Vendredi	début semaine	fin semaine	Lundi	Mardi	Mercredi	Jeudi	Vendredi
1	0	0	0	0	0	0	29/12/2014	02/01/2015
2	11	3	2	2	2	2	05/01/2015	09/01/2015	05/01/2015	06/01/2015	07/01/2015	08/01/2015	09/01/2015
3	11	3	2	2	2	2	12/01/2015	16/01/2015	12/01/2015	13/01/2015	14/01/2015	15/01/2015	16/01/2015
4	11	3	2	2	2	2	19/01/2015	23/01/2015	19/01/2015	20/01/2015	21/01/2015	22/01/2015	23/01/2015
5	12	3	3	2	2	2	26/01/2015	30/01/2015	26/01/2015	27/01/2015	28/01/2015	29/01/2015	30/01/2015
6	10	2	2	2	2	2	02/02/2015	06/02/2015	02/02/2015	03/02/2015	04/02/2015	05/02/2015	06/02/2015
7	10	2	2	2	2	2	09/02/2015	13/02/2015	09/02/2015	10/02/2015	11/02/2015	12/02/2015	13/02/2015
8	11	3	2	2	2	2	16/02/2015	20/02/2015	16/02/2015	17/02/2015	18/02/2015	19/02/2015	20/02/2015
9	10	2	2	2	2	2	23/02/2015	27/02/2015	23/02/2015	24/02/2015	25/02/2015	26/02/2015	27/02/2015
10	9	2	2	2	2	1	02/03/2015	06/03/2015	02/03/2015	03/03/2015	04/03/2015	05/03/2015	06/03/2015

J'ai modifier pour prendre en compte :

Code :

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

1
2
3
4
5
6
7
8
9
For i = 10 To 15 Step 1
 
        ' on boucle autant de fois que le nombre de pièces à produire sur cette journée
        For j = 0 To CellSource.Offset(0, i)
 
            ' on écrit la date de production sur les "j" lignes de tableau 1
            CellDest.Offset(j, 1) = CDate(CellSource.Offset(0, i + 1))
 
        Next j

Mais j'ai le message d'erreur "depassement de capacité".

**joe.levrai** · 31/03/2015, 11h13

voilà la modification, à tester

j'ai mis en commentaire les deux zones qu'il fallait modifier

dis moi si c'est ok

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
 
 
Sub date_prod()
 
    Dim i As Integer
    Dim j As Integer
    Dim ShSource As Worksheet
    Dim ShDest As Worksheet
    Dim CellSource As Range
    Dim CellDest As Range
    Dim Reponse As String
    Dim DerLig As Long
 
    ' récupération du numéro de semaine
    ' attention à prévoir la vérification que la réponse est bien un numéro de semaine
    ' et gérer le cas où l'utilisateur ferme l'invite ou annule l'invite
    Reponse = InputBox("Veuillez indiquer le numéro de semaine")
 
    ' mise sous variable des deux feuilles
    With ThisWorkbook
 
        Set ShSource = .Worksheets("Tableau2")
        Set ShDest = .Worksheets("Tableau1")
 
    End With
 
    DerLig = ShDest.UsedRange.Rows.Count
 
    ' tri ascendant de la colonne
    With ShDest.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("F1", "F" & DerLig), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("A1", "G" & DerLig)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
    ' on cherche la ligne du tableau 2 qui contient le numéro de semaine
    ' on positionne CellSource sur la colonne A de cette ligne
    For i = 2 To DerLig
        If ShSource.Range("A" & i) = Reponse Then
 
            Set CellSource = ShSource.Range("A" & i)
            Exit For
 
        End If
    Next i
 
    ' gestion du cas où cette semaine n'existe pas dans tableau 2
    If CellSource Is Nothing Then
 
        MsgBox ("La semaine " & Reponse & " n'existe pas dans Tableau2")
        Exit Sub
 
    End If
 
    ' on cherche la première ligne de tableau 1 qui contient ce numéro de semaine
    For i = 2 To DerLig
        If ShDest.Range("F" & i) = Reponse Then
 
            Set CellDest = ShDest.Range("F" & i)
            Exit For
 
        End If
    Next i
 
    ' gestion du cas où cette semaine n'existe pas dans tableau 1
    If CellDest Is Nothing Then
 
        MsgBox ("La semaine " & Reponse & " n'existe pas dans Tableau1")
        Exit Sub
 
    End If
 
    ' $$$$ MODIFIE $$$$
    ' pour les 5 jours de la semaine
    For i = 2 To 6
    ' $$$$ FIN MODIFIE $$$$
 
        ' on boucle autant de fois que le nombre de pièces à produire sur cette journée
        For j = 0 To CellSource.Offset(0, i) - 1
 
            ' $$$$ MODIFIE $$$$
            ' on écrit la date de production sur les "j" lignes de tableau 1
            CellDest.Offset(j, 1) = CDate(CellSource.Offset(0, i + 7))
            ' $$$$ FIN MODIFIE $$$$
 
        Next j
 
        ' après avoir fini le traitement de la journée, on décale la ligne d'écrite dans tableau2
        Set CellDest = CellDest.Offset(CellSource.Offset(0, i), 0)
 
    Next i
 
    Set CellDest = Nothing
    Set CellSource = Nothing
    Set ShDest = Nothing
    Set ShSource = Nothing
 
End Sub

**shipuden64** · 31/03/2015, 12h05

Un graaannd merci ça marche du tonnerre

Par contre juste une petite précision si je ne veux plus saisir la semaine dans l'input et faire un For to par exemple en fonction de la semaine (colonne F) je peux ou c'est chose impossible ?

Voici le bout de code que j'ai testé mais qui ne marche pas. Je vais essayer avec un vlookup

Code :

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

1
2
3
    For i = 2 To DerLig
    Reponse = Range("F" & i)
    Next i

**joe.levrai** · 31/03/2015, 16h30

Il va falloir remodeler un peu le code si tu veux que ça boucle sur toutes les semaines existantes dans le tableau 2

je te prépare ça demain, là je suis pris par le temps

**shipuden64** · 01/04/2015, 13h46

Ok, je te remercie pour ton aide

**joe.levrai** · 01/04/2015, 15h34

Bonjour,

voici une nouvelle méthode pour boucler sur chaque ligne de tableau 2, en utilisant les filtres automatiques dans tableau 1

y'a encore des optimisations possibles, mais le code est fonctionnel pour ton besoin

tiens nous au courant

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
 
 
 
Sub date_prod()
 
    Dim i As Integer
    Dim j As Integer
    Dim l As Integer
    Dim ShSource As Worksheet
    Dim ShDest As Worksheet
    Dim CellSource As Range
    Dim Cell As Range
    Dim Reponse As String
    Dim DerLigSource As Long
    Dim DerLigDest As Long
    Dim PlageFiltre As Range
 
    ' mise sous variable des deux feuilles
    With ThisWorkbook
 
        Set ShSource = .Worksheets("Tableau2")
        Set ShDest = .Worksheets("Tableau1")
 
    End With
 
    DerLigDest = ShDest.UsedRange.Rows.Count
    DerLigSource = ShSource.UsedRange.Rows.Count
 
    ' tri ascendant de la colonne
    With ShDest.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("F1", "F" & DerLigDest), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("A1", "G" & DerLigDest)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
    ' on boucle sur chaque ligne de tableau2
    ' on positionne CellSource sur la colonne A de cette ligne
    For i = 2 To DerLigSource
 
        Set CellSource = ShSource.Range("A" & i)
        Reponse = ShSource.Range("A" & i)
 
        With ShDest
 
            ' désactive les filtres automatiques
            .AutoFilterMode = False
 
            With .Range("A1")
 
                ' on filtre la colonne F avec le numéro de semaine
                .AutoFilter 6, Reponse, xlFilterValues
 
            End With
 
            ' on récupère la plage filtrée
            ' gestion du cas où le numéro de semaine testé n'existe pas dans tableau 1
            If .Range(.Cells(1, 6), .Cells(DerLigDest, 6)).SpecialCells(xlCellTypeVisible).Address = "$F$1" Then
 
                Set PlageFiltre = Nothing
 
            Else
 
                Set PlageFiltre = .Range(.Cells(2, 6), .Cells(DerLigDest, 6)).SpecialCells(xlCellTypeVisible)
 
            End If
 
        End With
 
        If Not PlageFiltre Is Nothing Then
 
            ' on se positionne sur la première cellule de la plage filtrée
            Set Cell = PlageFiltre(1, 1)
 
            ' pour les 5 jours de la semaine
            For j = 2 To 6
                 ' on boucle autant de fois que le nombre de pièces à produire sur cette journé
                For l = 0 To CellSource.Offset(0, j) - 1
 
                    ' on écrit la date de production sur les "l" lignes de tableau 1
                    Cell.Offset(l, 1) = CDate(CellSource.Offset(0, j + 7))
 
                Next l
 
                ' on décale Cell pour écrire le jour de la semaine suivant
                Set Cell = Cell.Offset(CellSource.Offset(0, j), 0)
 
            Next j
        End If
    Next i
 
    ShDest.AutoFilterMode = False
 
    Set PlageFiltre = Nothing
    Set Cell = Nothing
    Set CellSource = Nothing
    Set ShDest = Nothing
    Set ShSource = Nothing
 
End Sub

**shipuden64** · 03/04/2015, 11h04

Bonjour à vous,
Excusez moi pour le retard. Merci pour ce bout de code il marche parfaitememtn

.
Je vous souhaite une bonne continuation

Répartition données dans plusieurs cellules sous conditions [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager