Discussion :

[Cedric_225]

Bonjour a tous,

Je travail sur l'édition d'un échéancier et je rencontre une difficulté.

Après avoir écrit un programme qui parcours les cellules des paiements que j'ai sur une feuille et qui ensuite copie/colle les données dont j'ai besoin sur une autre.

j'ai besoin de trier ces données en fonction des dates et aussi les compléter jusqu'au terme de l'année. C'est a dire si on a dans notre tableau un échéancier qui a pour dernière date le 01/07/2021, on ajoute des lignes 01/08/2021, 01/08/2021,..., 01/12/2021.

Vous trouverez une image d'illustration en pièce jointe afin de mieux comprendre.



Comme l'indique l'image, je veux trier par ordre croissant les dates encadrées en rouge et compléter les lignes jusqu'au 01/12.

Vous trouverez également en pièce jointe mon fichier contenant le code.

Merci d'avance à vous pour votre aide.

Bien cordialement

[EricDgn]

Bonjour,

Une façon de faire:

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
Option Explicit
 
Sub Retraitement()
    Dim i As Long, j As Long, k As Long
    Dim NbLignes As Integer, sContrat As String
    Dim wshCap As Worksheet, wshWrd As Worksheet
 
    Set wshWrd = ThisWorkbook.Worksheets("SARL_NP2J_AUTOMOBILES")
    Set wshCap = ThisWorkbook.Worksheets("Captures")
    j = 3
    k = j
    wshWrd.Select
    NbLignes = Range("B" & Rows.Count).End(xlUp).Row
 
    With wshCap
        For i = 1 To NbLignes
            If Range("B" & i) = "CONTRAT" Then
                Trier k, j
                Range(Cells(i, 2), Cells(i, 8)).Copy .Range("B" & j)
                sContrat = Range("C" & i)
                j = j + 1
                k = j
            ElseIf Range("B" & i) = "MA" Then
                Range(Cells(i, 2), Cells(i, 8)).Copy .Range("B" & j)
                .Range("H" & j) = sContrat
                j = j + 1
            End If
        Next i
        Trier k, j
    End With
    wshCap.Select
    Set wshWrd = Nothing
    Set wshCap = Nothing
End Sub
 
Private Sub Trier(k As Long, j As Long)
    Dim wshCap As Worksheet, rTri As Range, rData As Range, i As Long
    'Debug.Print k, j
    If k = j Then Exit Sub
    Set wshCap = ThisWorkbook.Worksheets("Captures")
    j = j - 1
    With wshCap
        Set rTri = Range(.Cells(k, 3), .Cells(j, 3))
        Set rData = Range(.Cells(k, 2), .Cells(j, 8))
        .Sort.SortFields.Clear
        .Sort.SortFields.Add2 Key:=rTri, SortOn:=xlSortOnValues, _
                                Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange rData
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        i = 12 - Month(.Range("C" & j).Value2)
        If i > 0 Then
            For i = 1 To i
                j = j + 1
                .Range("C" & j).Value = DateAdd("m", 1, .Range("C" & j - 1).Value2)
            Next i
        End If
    End With
    j = j + 1
    Set rData = Nothing
    Set rTri = Nothing
    Set wshCap = Nothing
End Sub

Sans doute à adapter.
Cordialement.

[Cedric_225]

Bonjour EricDgn,

Vraiment merci beaucoup pour votre code, il m'a beaucoup aidé dans mon projet.
J'ai eu un peu de mal à vous exposer le problème, et mon message n'était pas très clair.
Mais vous avez quand même réussi à trouver la solution.

Merci beaucoup encore,
Bien cordialement