Discussion :

[Awans]

Bonjour à tous !

Je débute sur VBA et j'ai un fichier de ce type :

A	Journée	Nb.Jours	Freq
##		2	1____6_
##		3	_23__6_

Il fait en réalité plusieurs dizaines de colonnes et des milliers de lignes, mais ne prenons que l'origine de mon problème, pour illustrer.
La colonne "Freq" indique quels jours de la semaine l'évènement A se produit. Cette colonne est toujours au même format : chaque chiffre correspond au jour de la semaine correspondant, et un "_" signifie que cet evenement ne se produit pas ce jour. Un évènement se produit toujours au moins une fois par semaine, donc la cellule "_______" ne peut pas exister.
La colonne "NB.Jours" est une colonne pour laquelle j'ai créé une macro qui copie la ligne le nombre de jours auxquels l'évènement A se produit (en comptant le nombre de chiffres de la cellule Freq). Donc, s'il y a deux chiffres dans la cellule freq, alors cette ligne se copiera 2 fois.
Cependant, j'aimerais ajouter à ma macro une fonctionnalité : pour chaque ligne dupliquée, le jour correspondant serait également rentré.
Je m'explique : si on a une Freq qui est : 1____6_, alors on aura Nb.Jours qui vaudra 2, donc la ligne se dupliquera une fois (pour avoir deux lignes), et je voudrais obtenir cela :

A	Journée	Nb.Jours	Freq
##	1	2	1____6_
##	6	2	1____6_
##	2	3	_23__6_
##	3	3	_23__6_
##	6	3	_23__6_

J'aimerais donc que chaque ligne copiée renvoie la valeur d'un chiffre présent dans la colonne "Freq". Je sui débutant sur VBA donc je galère un petit peu, mais j'imagine que c'est faisable.

J'avais commencé un bout de code avec une double boucle for, mais j'ai à chaque fois une erreur différente, je ne pense pas que cela vous avance beaucoup. J'ai auparavant déclaré les variables suivantes :

Code :

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

1
2
3
4
5
6
7
8
9
 
Freq = Cells(i, 18).Value
Lundi = Mid(Freq, 1, 1)
Mardi = Mid(Freq, 2, 1)
Mercredi = Mid(Freq, 3, 1)
Jeudi = Mid(Freq, 4, 1)
Vendredi = Mid(Freq, 5, 1)
Samedi = Mid(Freq, 6, 1)
Dimanche = Mid(Freq, 7, 1)

Et ait tenté une boucle qui cherche si tel jour correspond, mais je n'en vois pas le bout, je trouve cette méthode assez fastidieuse, peut etre qu'une autre solution serait plus simple ?

Merci à vous d'avoir pris le temps de me lire, et bonne journée !!

[Invité]

Bonjour,

En admettant que vos lignes soient déjà dupliquées :

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
 
 
Sub TestRemplirLaColonneJour()
 
    RemplirLaColonneJour Range("D2:D6"), 2
 
End Sub
 
Sub RemplirLaColonneJour(ByVal AireFrequence As Range, ByVal ColonneJournee As Long)
 
Dim CelluleFrequence As Range
Dim CompteurEnCours As Integer
Dim FrequenceEnCours As String
 
        FrequenceEnCours = ""
 
 
        For Each CelluleFrequence In AireFrequence
            If CelluleFrequence = FrequenceEnCours Then
               CelluleFrequence.Offset(0, ColonneJournee - AireFrequence.Column) = MatriceFrequence(CompteurEnCours)
               CompteurEnCours = CompteurEnCours + 1
            Else
               RemplirMatriceFrequence CelluleFrequence
               CompteurEnCours = 0
               CelluleFrequence.Offset(0, ColonneJournee - AireFrequence.Column) = MatriceFrequence(CompteurEnCours)
               CompteurEnCours = CompteurEnCours + 1
               FrequenceEnCours = CelluleFrequence
            End If
        Next CelluleFrequence
 
 
End Sub
 
Sub RemplirMatriceFrequence(ByVal ValeurFrequence As String)
 
Dim I As Long, NbJours As Long
Dim MesJoursDeLaSemaine As Variant
 
    MesJoursDeLaSemaine = Array("Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi", "Dimanche")
    NbJours = 0
    For I = 1 To Len(ValeurFrequence)
         If Mid(ValeurFrequence, I, 1) <> "_" Then
            ReDim Preserve MatriceFrequence(NbJours)
            MatriceFrequence(NbJours) = MesJoursDeLaSemaine(Mid(ValeurFrequence, I, 1) - 1)
            NbJours = NbJours + 1
         End If
    Next I
 
End Sub

Pièce jointe 406398

[78chris]

Bonjour à tous

Sur Excel 2016 intégrant PowerQuery ou add on installé sur 2010 ou 2013, on peut faire sans VBA sur de grands volumes



Si j'ai bien compris les colonnes journée et nombre de jours n'existent pas initialement : je ne les ai donc pas utilisées (tableau bleu).
Le tableau des jours (rouge) n'est pas obligatoire, on pourrait le remplacer par une formule dans PowerQuery

Le résultat (tableau vert) : on pourrait dans PowerQuery y calculer nombre de jours si cette colonne est utile.

[Awans]

Merci beaucoup Eric ! C'est exactement ce que je veux faire.

Cependant j'ai un peu de mal à discerner le rôle des variables ici, et je n'arrive pas à appliquer le programme à mon classeur. A quoi correspondent les variables "AirFrequence" ?
Dois-je recommencer en renommant chaque variable ?

Merci beaucoup pour votre aide

Bonjour,

En admettant que vos lignes soient déjà dupliquées :

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
 
 
Sub TestRemplirLaColonneJour()
 
    RemplirLaColonneJour Range("D2:D6"), 2
 
End Sub
 
Sub RemplirLaColonneJour(ByVal AireFrequence As Range, ByVal ColonneJournee As Long)
 
Dim CelluleFrequence As Range
Dim CompteurEnCours As Integer
Dim FrequenceEnCours As String
 
        FrequenceEnCours = ""
 
 
        For Each CelluleFrequence In AireFrequence
            If CelluleFrequence = FrequenceEnCours Then
               CelluleFrequence.Offset(0, ColonneJournee - AireFrequence.Column) = MatriceFrequence(CompteurEnCours)
               CompteurEnCours = CompteurEnCours + 1
            Else
               RemplirMatriceFrequence CelluleFrequence
               CompteurEnCours = 0
               CelluleFrequence.Offset(0, ColonneJournee - AireFrequence.Column) = MatriceFrequence(CompteurEnCours)
               CompteurEnCours = CompteurEnCours + 1
               FrequenceEnCours = CelluleFrequence
            End If
        Next CelluleFrequence
 
 
End Sub
 
Sub RemplirMatriceFrequence(ByVal ValeurFrequence As String)
 
Dim I As Long, NbJours As Long
Dim MesJoursDeLaSemaine As Variant
 
    MesJoursDeLaSemaine = Array("Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi", "Dimanche")
    NbJours = 0
    For I = 1 To Len(ValeurFrequence)
         If Mid(ValeurFrequence, I, 1) <> "_" Then
            ReDim Preserve MatriceFrequence(NbJours)
            MatriceFrequence(NbJours) = MesJoursDeLaSemaine(Mid(ValeurFrequence, I, 1) - 1)
            NbJours = NbJours + 1
         End If
    Next I
 
End Sub

Pièce jointe 406398