Remplir un tableau à partir d'un autre

Version imprimable

Voir 40 message(s) de cette discussion en une page

06/07/2012, 11h51
sylvestre09

1 pièce(s) jointe(s)

Bonjour Daniel voilà en details les calculs à faire!
Mercii !!
06/07/2012, 19h49
Daniel.C

Une précision, pourquoi la référence 120419001 n'est-elle pas prise en compte ?
06/07/2012, 22h40
Daniel.C

Ne tiens pas compte de ma question.
10/07/2012, 10h39
sylvestre09

t'as des questions Daniel ? apparemment c'est pas facile :(

J'étais sûr d'avoir posté la réponse dimanche ! pfft... faut pas vieillir ! je mettrai les commentaires quand tu me diras que c'est OK.

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
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
Sub Pret_Emprunt_v1()
    Dim c As Range, Ctr As Double, x As Range, Somme As Double, Moyenne As Single
    Dim Ligne As Long, LigneDeb As Long, LigneCred As Long
    Dim Min As Date, Mois As Object, Plage As Range, Ech As Object
    Dim Taux As Single, Intr As Double, échéance As Variant
 
    Ligne = 2
    With Sheets("Exemple")
        .AutoFilterMode = False
        Set Plage = Range([C3], Cells(Rows.Count, 3).End(xlUp)).Resize(, 11)
        Plage.AutoFilter
        .AutoFilter.Sort.SortFields.Clear
        .AutoFilter.Sort.SortFields.Add Key:= _
        Plage.Resize(, 1).Offset(, 2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
        .AutoFilter.Sort.Apply
        Set Mois = Nothing
        Set Ech = Nothing
        Set Ech = CreateObject("Scripting.Dictionary")
        Set Mois = CreateObject("Scripting.Dictionary")
             For Each c In Range([E4], Cells(Rows.Count, 5).End(xlUp))
               If Not Mois.exists(DateSerial(Year(c.Value), Month(c.Value), 1)) Then
                 Mois.Add DateSerial(Year(c.Value), Month(c.Value), 1), _
                     DateSerial(Year(c.Value), Month(c.Value), 1)
             End If
            If Not Ech.exists(c.Value) Then
                Ech.Add c.Value, c.Value
            End If
        Next c
        .AutoFilterMode = False
        For Each Item In Mois
            Ctr = 0
            Ligne = Ligne + 2
            .Cells(Ligne, 40) = DateSerial(Year(Item), Month(Item), 1)
            .Cells(Ligne, 40).NumberFormat = "mmm-yyyy"
            LigneDeb = Ligne
            LigneCred = Ligne
            For Each échéance In Ech
                If DateSerial(Year(échéance), Month(échéance), 1) = .Cells(Ligne, 40) Then
                    'calcul de l'échéance
                    .AutoFilterMode = False
                    Set Plage = .Range(.[C3], .Cells(.Rows.Count, 3).End(xlUp)).Resize(, 11)
                    Plage.AutoFilter 3, Format(échéance, "dd/mm/yyyy")
                    .AutoFilter.Sort.SortFields.Clear
                    .AutoFilter.Sort.SortFields.Add Key:= _
                    Plage.Resize(, 1).Offset(, 1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
                    xlSortTextAsNumbers
                    .AutoFilter.Sort.Apply
                    Set Plage = Plage.Offset(1).Resize(Plage.Rows.Count - 1, 1)
                    Set Plage = Plage.SpecialCells(xlCellTypeVisible)
                    Somme = 0
                    nbr = 0
                    Intr = 0
                    For Each c In Plage
                        nbr = nbr + 1
                        If nbr = 1 Then
                            Somme = c.Offset(, 4)
                            Intr = c.Offset(, 4) * c.Offset(, 5) / 100
                        Else
                            If Somme < 0 And Somme + c.Offset(, 4) > 0 Or _
                            Somme > 0 And Somme + c.Offset(, 4) < 0 Then
                                Somme = Somme + c.Offset(, 4)
                                Intr = (Somme * c.Offset(, 5)) / 100
                            Else
                                Somme = Somme + c.Offset(, 4)
                                Intr = Intr + (c.Offset(, 4) * c.Offset(, 5)) / 100
                            End If
                        End If
                    Next c
                    Taux = (Intr / Somme) * 100
                    If Somme > 0 Then 'Si la somme des valeurs "c" pour la meme date est positive alors
                        .Cells(LigneCred, "AR") = échéance
                        .Cells(LigneCred, "AQ") = Taux
                        .Cells(LigneCred, "AP") = Somme 'la somme des valeurs "c"
                        Ctr = Ctr + Somme
                        LigneCred = LigneCred + 1
                    Else
                        .Cells(LigneDeb, "AM") = échéance
                        .Cells(LigneDeb, "AL") = Taux
                        .Cells(LigneDeb, "AK") = Somme
                        Ctr = Ctr + Somme
                        LigneDeb = LigneDeb + 1
                    End If
                End If
                .AutoFilterMode = False
            Next échéance
            .Cells(Ligne + 1, 40) = Ctr
            .Cells(Ligne + 1, 40).NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
            Ligne = Application.Max(LigneCred, LigneDeb)
        Next Item
    End With
End Sub

10/07/2012, 16h08
sylvestre09

ca bloque à ce niveau

Code:

.AutoFilter.Sort.SortFields.Clear

(je te rappelle que je travaille sur excel 2003)

Citation:

(je te rappelle que je travaille sur excel 2003)

OK, ça m'était sorti de la tête ! C'est à reprendre. Ca ne doit pas être très compliqué à modifier, par contre, mon gamin est en train d'emménager et je fais le maxi pour l'aider, vu qu'il travaille comme un malade. L'appart est neuf et il n'y a même pas le téléphone, ce qui fait que même quand je suis là-bas, je ne peux rien faire. Je te mets en priorité haute, évidemment. Je devrais avoir un trou demain après-midi, alors, je regarderai. N'hésite pas à me relancer si tu vois que ça traîne.

Essaie :

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
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
Sub Pret_Emprunt_v1()
    Dim c As Range, Ctr As Double, x As Range, Somme As Double, Moyenne As Single
    Dim Ligne As Long, LigneDeb As Long, LigneCred As Long
    Dim Min As Date, Mois As Object, Plage As Range, Ech As Object
    Dim Taux As Single, Intr As Double, échéance As Variant
 
    Ligne = 2
    With Sheets("Exemple")
        .AutoFilterMode = False
        Set Plage = Range([C3], Cells(Rows.Count, 3).End(xlUp)).Resize(, 11)
        Plage.AutoFilter
'        .AutoFilter.Sort.SortFields.Clear '*************************************
'        .AutoFilter.Sort.SortFields.Add Key:= _
'        Plage.Resize(, 1).Offset(, 2), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
'        xlSortTextAsNumbers
'        .AutoFilter.Sort.Apply
        Plage.Sort .[E3], xlAscending, header:=xlYes
        Set Mois = Nothing
        Set Ech = Nothing
        Set Ech = CreateObject("Scripting.Dictionary")
        Set Mois = CreateObject("Scripting.Dictionary")
             For Each c In Range([E4], Cells(Rows.Count, 5).End(xlUp))
               If Not Mois.exists(DateSerial(Year(c.Value), Month(c.Value), 1)) Then
                 Mois.Add DateSerial(Year(c.Value), Month(c.Value), 1), _
                     DateSerial(Year(c.Value), Month(c.Value), 1)
             End If
            If Not Ech.exists(c.Value) Then
                Ech.Add c.Value, c.Value
            End If
        Next c
        .AutoFilterMode = False
        For Each Item In Mois
            Ctr = 0
            Ligne = Ligne + 2
            .Cells(Ligne, 40) = DateSerial(Year(Item), Month(Item), 1)
            .Cells(Ligne, 40).NumberFormat = "mmm-yyyy"
            LigneDeb = Ligne
            LigneCred = Ligne
            For Each échéance In Ech
                If DateSerial(Year(échéance), Month(échéance), 1) = .Cells(Ligne, 40) Then
                    'calcul de l'échéance
                    .AutoFilterMode = False
                    Set Plage = .Range(.[C3], .Cells(.Rows.Count, 3).End(xlUp)).Resize(, 11)
                    'Plage.AutoFilter 3, Format(échéance, "mm/dd/yyyy")
                    Plage.AutoFilter 3, DateSerial(Year(échéance), Month(échéance), Day(échéance))
'                    .AutoFilter.Sort.SortFields.Clear '*****************************************
'                    .AutoFilter.Sort.SortFields.Add Key:= _
'                    Plage.Resize(, 1).Offset(, 1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
'                    xlSortTextAsNumbers
'                    .AutoFilter.Sort.Apply
                    Plage.Sort .[D3], xlAscending, header:=xlYes
                    Set Plage = Plage.Offset(1).Resize(Plage.Rows.Count - 1, 1)
                    Set Plage = Plage.SpecialCells(xlCellTypeVisible)
                    Somme = 0
                    nbr = 0
                    Intr = 0
                    For Each c In Plage
                        nbr = nbr + 1
                        If nbr = 1 Then
                            Somme = c.Offset(, 4)
                            Intr = c.Offset(, 4) * c.Offset(, 5) / 100
                        Else
                            If Somme < 0 And Somme + c.Offset(, 4) > 0 Or _
                            Somme > 0 And Somme + c.Offset(, 4) < 0 Then
                                Somme = Somme + c.Offset(, 4)
                                Intr = (Somme * c.Offset(, 5)) / 100
                            Else
                                Somme = Somme + c.Offset(, 4)
                                Intr = Intr + (c.Offset(, 4) * c.Offset(, 5)) / 100
                            End If
                        End If
                    Next c
                    Taux = (Intr / Somme) * 100
                    If Somme > 0 Then 'Si la somme des valeurs "c" pour la meme date est positive alors
                        .Cells(LigneCred, "AR") = échéance
                        .Cells(LigneCred, "AQ") = Taux
                        .Cells(LigneCred, "AP") = Somme 'la somme des valeurs "c"
                        Ctr = Ctr + Somme
                        LigneCred = LigneCred + 1
                    Else
                        .Cells(LigneDeb, "AM") = échéance
                        .Cells(LigneDeb, "AL") = Taux
                        .Cells(LigneDeb, "AK") = Somme
                        Ctr = Ctr + Somme
                        LigneDeb = LigneDeb + 1
                    End If
                End If
                .AutoFilterMode = False
            Next échéance
            .Cells(Ligne + 1, 40) = Ctr
            .Cells(Ligne + 1, 40).NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
            Ligne = Application.Max(LigneCred, LigneDeb)
        Next Item
    End With
End Sub

PS. Il reste un dernier point à régler si ça te pose un problème : à la fin de la macro, les données sont triées par dates d'échéance et date de valeur. Ce n'est pas grand-chose de les remettre dans l'ordre initial.

12/07/2012, 10h11
sylvestre09

Bonjour Daniel
ca bloque a ce niveau

Code:

Set Plage = Plage.SpecialCells(xlCellTypeVisible)

j'ai regardé et j'ai trouvé que dans le filtre il prend ladate 7/16/12 !!! et donc les cellules ne sont pas visibles !!
une autre question à coté de mon tableau j'ai plusieurs tableaux et des calculs pour chaque ligne est ce qu'on faison des filtres et des tri ca ne derange pas ?
12/07/2012, 10h56
Daniel.C

1 pièce(s) jointe(s)

Voici le classeur qui m'a servi de test. Fais moi suivre le tien.

Voir 40 message(s) de cette discussion en une page