VBA : Remplissage conditionnel complexe

Version imprimable

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:

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 !!

Citation:

Envoyé par Awans

Bonjour,

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

Code:

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

25/08/2018, 09h18
78chris

1 pièce(s) jointe(s)

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

Pièce jointe 406421

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.

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

Citation:

Envoyé par Eric KERGRESSE

Bonjour,

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

Code:

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

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_