Discussion :

[eric4459]

Bonjour à tous,
J'ai une série de données que je souhaite traiter: la première ligne contient des dates la seconde des pourcentages associés à ces dates, la troisième ligne contient des dates, la quatrième des pourcentages associés à ces dates etc...
Les dates de chaque série ne sont pas identiques



Je souhaiterai obtenir ceci



J'ai donc créé du code, qui est encore en cours de création, pour décaler mes lignes dans un sens ou dans l'autre pour avoir des dates identiques sur chaque colonne:

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
Sub test()
Dim Baseline As Worksheet
Dim Actual As Worksheet
Dim Bsl As Range
Dim Act As Range
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim m As Integer
Dim n As Integer
Dim p As Integer
Set Baseline = ThisWorkbook.Sheets("Baseline")
Set Actual = ThisWorkbook.Sheets("Actual")
Set Bsl = Baseline.Range("A1")
Set Act = Actual.Range("A1")
Bsl = Bsl.Offset(0)
Act = Act.Offset(0)
i = 0
j = 0
k = 0
 
                Do While Bsl.Offset(0) <> Bsl.Offset(i + 5, j)
                    If Bsl.Offset(i + 5, j) <> "" And Bsl.Offset(0) < Bsl.Offset(i + 5, j) Then
                            Range(Bsl.Offset(i + 5, j), Bsl.Offset(i + 9, j).End(xlToRight)).Cut
                            Bsl.Offset(i + 5, j + 1).Select
                            ActiveSheet.Paste
                            Bsl.Offset(i + 5, j) = Bsl.Offset(i, j)
                            Bsl.Offset(i + 5, j).NumberFormat = "[$-410]dd-mmm-yy;@"
                            Bsl.Offset(i + 6, j) = 0
                            Bsl.Offset(i + 6, j).NumberFormat = "0.00%"
 
                    End If
 
                    If Bsl.Offset(i + 5, j) <> "" And Bsl.Offset(i, j) > Bsl.Offset(i + 5, j) Then
 
                            Application.CutCopyMode = False
                            Range(Bsl.Offset(i, j), Bsl.Offset(i, j + 5).End(xlToRight).End(xlDown)).Cut
                            Bsl.Offset(i, j + 1).Select
                            ActiveSheet.Paste
                            Bsl.Offset(i, j) = Bsl.Offset(i + 5, j)
                            Bsl.Offset(i, j).NumberFormat = "[$-410]dd-mmm-yy;@"
                            Bsl.Offset(i + 1, j) = 0
                            Bsl.Offset(i + 1, j).NumberFormat = "0.00%"
 
                    End If
                    i = i + 5
 
                Loop
 
End Sub

Mon problème survient après les lignes suivantes:

Code :

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

1
2
3
4
 Range(Bsl.Offset(i, j), Bsl.Offset(i, j + 5).End(xlToRight).End(xlDown)).Cut
 Bsl.Offset(i, j + 1).Select
 ActiveSheet.Paste
 Bsl.Offset(i, j) = Bsl.Offset(i + 5, j)

Alors que Bsl.Offset(i, j) devrai etre situé en colonne A, après l'opération coller, elle se situe en colonne B.
Je pense que cela vient du code

Code :

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

1
2
Bsl.Offset(i, j + 1).Select
 ActiveSheet.Paste

Mais je n'ai pas trouvé de méthode plus orthodoxe pour parvenir à décaler mes valeurs ( en plus j'utilise du .Select dont je souhaiterai me passer).

Quelqu'un a-t-il une idée soit pour couper/coller "proprement" soit pour éviter le décalage de mon offset?

Merci pour votre aide et votre collaboration

Eric

[joe.levrai]

Bonjour eric4459

si j'ai bien compris, tu souhaites combler les mois manquants dans chaque ligne, afin d'obtenir pour chaque ligne la même série de dates, et si la date n'existait pas, tu lui affectes un pourcentage à 0 ?

si tel est le cas, tu peux très bien :

-parcourir toutes tes lignes dates pour trouver tous les mois existants, qui constituerons donc la série date définitive.
- reporter cette série définitive dans une nouvelle feuille en conservant la même numérotation des lignes
- balayer les lignes "pourcentages" pour trouver les pourcentage qui existaient ... ou le mettre à 0 si inexistant ?

[eric4459]

Bonjour Joe.levrai
Effectivement c'est ce que cherche à réaliser: si les dates ne correspondent pas, je décale la série et mets la date la plus ancienne des deux et 0 comme % dans la cellule devenue vide.
Je crois que c'est la méthode couper/coller qui est en cause.
Normalement, mais c'est là que je bloque, je devrai affecter les nouvelles valeurs (date et % à 0)en colonne A mais c'est en colonne B que le code intervient.

Code :

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

1
2
3
Set Bsl = Baseline.Range("A1")
Bsl = Bsl.Offset(0)
Bsl.Offset(i, j) = Bsl.Offset(i + 5, j)

Je ne comprend pas trop pourquoi, d'après moi cela vient de

Code :

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

1
2
3
 Range(Bsl.Offset(i, j), Bsl.Offset(i, j + 5).End(xlToRight).End(xlDown)).Cut
 Bsl.Offset(i, j + 1).Select
 ActiveSheet.Paste

et je bloque.

Pourrais tu m'en dire un peu plius sur la solution que tu préconises?
Eric

[joe.levrai]

un essai rapide, je suis parti de ton print écran (= les dates sont toujours dans l'ordre croissant)
j'ai testé sur 3 lignes et 17 colonnes et ça fonctionne
regarde si c'est ok, et surtout si c'est pas trop long, y'a encore pas mal d'optimisations possibles

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
 
Sub Conversion()
 
    Dim ShSource As Worksheet
    Dim ShDest As Worksheet
    Dim Plage As Range
    Dim ListeDate() As String
    Dim NbColDest As Long
    Dim i As Long
    Dim j As Long
    Dim t As Long
 
    Set ShSource = ThisWorkbook.Worksheets("Feuil1")
    Set ShDest = ThisWorkbook.Worksheets("Feuil2")
 
    With ShSource
 
        ' l'ensemble des lignes de dates
        Set Plage = .Range(.Cells(1, 1), .Cells(1, .UsedRange.Columns.Count))
        For i = 3 To .UsedRange.Rows.Count Step 2
            Set Plage = Union(Plage, .Range(.Cells(i, 1), .Cells(i, .UsedRange.Columns.Count)))
        Next i
 
        ' liste sans doublon des dates, triées par ordre croissant
        ListeDate = TriDate(Split(SansDoublon(Plage, "$"), "$"))
 
        ' boucle sur chaque ligne de date
        For i = 1 To .UsedRange.Rows.Count Step 2
 
            ' écriture des dates dans la feuille de destination
            ShDest.Cells(i, 1) = Format(ListeDate(UBound(ListeDate)), "[$-40C]dd-mmm-yy;@")
            For j = LBound(ListeDate) To UBound(ListeDate) - 1
                ShDest.Cells(i, j + 2) = Format(ListeDate(j), "[$-40C]dd-mmm-yy;@")
            Next j
 
            NbColDest = ShDest.UsedRange.Columns.Count
            t = 1
 
            For j = 1 To NbColDest
                Do Until t > NbColDest
                    ' écriture de 0,00% pour les dates inexistantes
                    If CDate(.Cells(i, j)) <> CDate(ShDest.Cells(i, t)) Then
                        ShDest.Cells(i + 1, t) = 0
                        t = t + 1
 
                    ' écriture du pourcentage pour les dates existantes
                    Else
                        ShDest.Cells(i + 1, t) = .Cells(i + 1, j)
                        t = t + 1
                        Exit Do
                    End If
                Loop
            Next j
 
            ShDest.Range(ShDest.Cells(i + 1, 1), ShDest.Cells(i + 1, NbColDest)).NumberFormat = "0%00"
 
        Next i
    End With
 
    Set Plage = Nothing
    Set ShDest = Nothing
    Set ShSource = Nothing
 
End Sub

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
 
Function TriDate(ListeDate As Variant) As Variant
Dim k As Long
Dim m As Long
Dim Chaine As Date
 
For m = 0 To UBound(ListeDate)
    For k = UBound(ListeDate) To 0 Step -1
        If CDate(ListeDate(k)) < CDate(ListeDate(m)) Then
            Chaine = ListeDate(k)
            ListeDate(k) = ListeDate(m)
            ListeDate(m) = Chaine
        End If
    Next k
Next m
 
TriDate = ListeDate
 
End Function

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
 
Function SansDoublon(Plage As Range, Optional Separateur As String) As String
 
    Dim EnumListe As String
    Dim Cell As Range
 
    EnumListe = ""
 
    If Separateur = "" Then
        Separateur = ","
    End If
 
    For Each Cell In Plage.Cells
        If EnumListe = "" And Cell <> "" Then
            EnumListe = EnumListe & Separateur & Cell & Separateur
        ElseIf Not EnumListe Like "*" & Separateur & Cell & Separateur & "*" And Cell <> "" Then
            EnumListe = EnumListe & Cell & Separateur
        End If
    Next Cell
 
    If EnumListe <> "" Then
        EnumListe = Mid(EnumListe, 2, Len(EnumListe) - 2)
    End If
 
    SansDoublon = EnumListe
 
End Function

[eric4459]

Bonjour joe.levrai,
Ton code fonctionne comme je le souhaite et de plus il est hyper rapide, cependant mon niveau de connaissance en VBA ne me permet pas d'en comprendre toute les subtilités, j'en suis encore au b-a ba, avancé certes mais au b-a ba tout de même.
Il faudra que j'étudie un peu plus ton code et les principes utilisés, les tableaux il me semble.
Mon problème à l'origine est différent, tu m'apporte du code sur un plateau, je t'en remercie, mais je ne comprend toujours pas pourquoi les lignes suivantes provoquent un décalage de mon offset.

Code :

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

1
2
3
Range(Bsl.Offset(i, j), Bsl.Offset(i, j + 5).End(xlToRight).End(xlDown)).Cut
 Bsl.Offset(i, j + 1).Select
ActiveSheet.Paste

J'ai en effet testé mon code sans ces lignes, donc sans tri des dates, et tout fonctionne comme je le souhaite, la fonction Offset répond au doigt et à l'oeil.
Eric

[joe.levrai]

Bonjour,

y'a des choses que je ne comprend pas très bien dans ton code
je met de côté les variables liées à la feuille Actual qui ne servent à rien, ça doit être pour la suite de ton code qui n'était pas terminé

Code :

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

1
2
3
4
 
Bsl = Bsl.Offset(0)
 
Do While Bsl.Offset(0) <> Bsl.Offset(i + 5, 0)

que voulais-tu faire avec ces Bsl.Offset(0) ?
sauf erreur, tu peux utiliser immédiatement Bsl

ensuite, ton j = 0 ne sert pas à grand chose, puisque tu n'incrémente jamais ton j, c'est plus lisible de laisser 0 dans tes offset à la place de j


après, je ne comprend pas non plus pourquoi tu boucle sur des pas de 5 lignes au lieu de boucler sur des pas de 2 lignes

Code :

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

1
2
3
4
5
6
7
8
 
Do While Bsl <> Bsl.Offset(i + 5, 0)
 
    ' blabla
 
    i = i + 5
 
Loop