Remplir un tableau à partir d'un autre

Version imprimable

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

je suppose que ca se passe a ce niveau

Code:

1
2
3
4
5
6
7
8
 With Sheets(occurs)
        Set PlageCopie = .Range("C4", .Range("C4").Offset(UBound(Tablo, 2) - 1, UBound(Tablo, 1) - 3))
        PlageCopie.Value = WorksheetFunction.Transpose(Tablo)
        DerLig = PlageCopie.SpecialCells(xlCellTypeLastCell).Row
    End With
 
    'Réinitialisation de la variable Tablo
    Erase Tablo

pour les doublons dans la table pret emprunt je pense que c'est a cause de ce code

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 If c.Offset(, 2) > 0 Then
                    .Cells(LigneCred, "AO") = .Cells(c.Row, 3)
                    .Cells(LigneCred, "AP") = .Cells(c.Row, 5)
                    .Cells(LigneCred, "AR") = .Cells(c.Row, 8)
                    .Cells(LigneCred, "AQ") = .Cells(c.Row, 7)
                    Ctr = Ctr + .Cells(c.Row, 7)
                    LigneCred = LigneCred + 1
                Else
                    .Cells(LigneDeb, "AJ") = .Cells(c.Row, 3)
                    .Cells(LigneDeb, "AK") = .Cells(c.Row, 5)
                    .Cells(LigneDeb, "AM") = .Cells(c.Row, 8)
                    .Cells(LigneDeb, "AL") = .Cells(c.Row, 7)
                    Ctr = Ctr + .Cells(c.Row, 7)
                    LigneDeb = LigneDeb + 1
                End If

que je viens de rectifier

Daniel j'ai mis

Code:

Module2.test (occurs)

en commentaire j'ai pas eu de soucis par rapport au dates donc il y'a quelque chose qui ne va pas dans le code que tu m'as fournis je pense fort au dictionnaire car c'est lui qui intervient dans la colonne E pour les dates d'echéances qu'est ce que t'en penses ?

29/03/2012, 13h33
Daniel.C

Citation:

en commentaire j'ai pas eu de soucis par rapport au dates donc il y'a quelque chose qui ne va pas dans le code que tu m'as fournis je pense fort au dictionnaire car c'est lui qui intervient dans la colonne E pour les dates d'echéances qu'est ce que t'en penses ?

RIEN, je n'en pense rien, je t'ai dit que je ne comprenais pas. Donne-moi un exemple d'anomalie.
29/03/2012, 16h23
sylvestre09

slt daniel en fait pour les onglets devises quand il copie les dates il change le format ou un truc comme ca ceci dit si dans l'onglet recap la date est 04-10-2012 il inscrit dans l'onglet euro 10-04-2012 il fait ca pour toutes les dates qui ont les jours inferieur à 12 !!c'est a dire pour le 15 mars 12 il mets 15 mars 12 par contre pour le 01 mars il me mets le 3 janvier 12 je ne sais pas comment modifier ça
29/03/2012, 17h00
Daniel.C

Si tu regardes les dates de départ, elles sont victimes de la même anomalie. Le problème survient au moment de l'utilisation de la fonction Transpose :

Code:

PlageCopie.Value = WorksheetFunction.Transpose(Tablo)

de la macro Gestion_Feuilles.
29/03/2012, 17h14
sylvestre09

faut la modifier cette ligne ?

J'ai rajouté cette rustine dans la macroGestion_Feuilles :

Code:

1
2
3
4
        For i = 1 To UBound(Tablo, 2)
            .[D4].Offset(i - 1) = Tablo(4, i)
            .[E4].Offset(i - 1) = Tablo(5, i)
        Next i

Ce qui corrige le problème. Au total :

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
Public Sub Gestion_Feuilles(occurs As String)
Dim i As Integer, n As Integer, nbcol As Integer
Dim f As Range, celcop As Range, PlageCopie As Range
Dim firstAddress As String
Dim Tablo() As Variant
Dim sh As Worksheet
Dim existe_feuil As Boolean
Dim DerLig As Long
Dim R As String
Dim DateEche As String
Dim Montant As String
Dim taux As String
Dim ValTabResultNeg As Integer
Dim ValTabResultPos As Integer
Dim DebTab As Integer 'N° de la première ligne du tableau
Dim finTab As Integer 'N° de la dernière ligne du tableau
 
 
    With Sheets("Recap")
        Set celcop = .Range("C3", .Cells(3, .Columns.Count).End(xlToLeft))
    End With
    'nombre de données à alimenter = dimension 1 de la variable Tablo
    nbcol = celcop.Columns.Count
    'Teste si la feuille existe
    existe_feuil = False
    For Each sh In Worksheets
        If sh.Name = occurs Then
            existe_feuil = True
            Exit For
        End If
    Next sh
    'Si la feuille n'existe pas, alors création de celle-ci avec nom et titres de colonnes adaptés
    If existe_feuil = False Then
        Sheets.Add Type:=xlWorksheet, After:=Sheets(Sheets.Count)
        celcop.Copy
        With ActiveSheet
            .Paste Destination:=.Range("C3")
            .Name = occurs
        End With
        Application.CutCopyMode = False
    End If
    'D'après l'aide en ligne de la méthode Find
    With liste
        Set f = .Find(occurs, LookIn:=xlValues)
        If Not f Is Nothing Then
            firstAddress = f.Address
            Do
                n = n + 1
                ReDim Preserve Tablo(3 To nbcol + 2, 1 To n)
                'Toutes les cellules de la ligne alimentent Tablo
                For i = 3 To nbcol + 2
                        Tablo(i, n) = f.Offset(0, i - 6)
                Next i
                Set f = .FindNext(f)
            Loop While Not f Is Nothing And f.Address <> firstAddress
        End If
    End With
    'Alimentation de la feuille
 
    With Sheets(occurs)
        Set PlageCopie = .Range("C4", .Range("C4").Offset(UBound(Tablo, 2) - 1, UBound(Tablo, 1) - 3))
        PlageCopie.Value = Application.Transpose(Tablo)
        For i = 1 To UBound(Tablo, 2)
            .[D4].Offset(i - 1) = Tablo(4, i)
            .[E4].Offset(i - 1) = Tablo(5, i)
        Next i
        DerLig = PlageCopie.SpecialCells(xlCellTypeLastCell).Row
    End With
 
    'Réinitialisation de la variable Tablo
    Erase Tablo
 
    Module2.test (occurs)
 
 
End Sub

29/03/2012, 17h33
sylvestre09

Super :) mercii Daniel pour le tableau pret emprunt je pense que je vais creer un bouton pour chaque onglet pour eviter le with :)
bonne soirée :)

bonjour Daniel, je sais que ce poste date d'un mois mais je me retourne vers toi (encore une fois) car je n'arrive pas a modifier le code que tu m'as fourni
voilà en commentaire la partie que je veux modifier

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
Sub Pret_Emprunt()
    Dim c As Range, Ctr As Double, x As Range
    Dim ligne As Long, LigneDeb As Long, LigneCred As Long
    Dim Min As Date, Dico As Object
 
    ligne = 2
    Set Dico = CreateObject("Scripting.Dictionary")
         For Each c In Range([E4], Cells(Rows.Count, 5).End(xlUp))
           If Not Dico.exists(DateSerial(Year(c.Value), Month(c.Value), 1)) Then
             Dico.Add DateSerial(Year(c.Value), Month(c.Value), 1), _
                 DateSerial(Year(c.Value), Month(c.Value), 1)
         End If
    Next c
 
    i = 0
    For Each Item In Dico.items
        i = i + 1
        Cells(i, "AH") = Item
    Next Item
    [AH:AH].Sort Range("AH1"), xlAscending, Header:=xlNo
    For Each x In Range([AH1], Cells(Rows.Count, "AH").End(xlUp))
        Ctr = 0
        ligne = ligne + 2
        Cells(ligne, 40) = DateSerial(Year(x.Value), Month(x.Value), 1)
        Cells(ligne, 40).NumberFormat = "mmm-yyyy"
        LigneDeb = ligne
        LigneCred = ligne
        For Each c In Range([E4], Cells(Rows.Count, 5).End(xlUp))
            If DateSerial(Year(c.Value), Month(c.Value), 1) = Cells(ligne, 40) Then
                If c.Offset(, 2) > 0 Then 'Si la somme des valeurs "c" pour la meme date est positive alors
                    Cells(LigneCred, "AR") = Cells(c.Row, 5)
                    Cells(LigneCred, "AQ") = Cells(c.Row, 8) 'la moyenne des valeurs de la colonne 8 correspondant à la somme de "c"
                    Cells(LigneCred, "AP") = Cells(c.Row, 7) 'la somme des valeurs "c"
                    Ctr = Ctr + Cells(c.Row, 7)
                    LigneCred = LigneCred + 1
                Else
                    Cells(LigneDeb, "AM") = Cells(c.Row, 5)
                    Cells(LigneDeb, "AL") = Cells(c.Row, 8) 'la moyenne des valeurs de la colonne 8 correspondant à la somme de "c"
                    Cells(LigneDeb, "AK") = Cells(c.Row, 7) 'la somme des valeurs "c"
                    Ctr = Ctr + Cells(c.Row, 7)
                    LigneDeb = LigneDeb + 1
                End If
            End If
        Next c
        Cells(ligne + 1, 40) = Ctr
        Cells(ligne + 1, 40).NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
        ligne = Application.Max(LigneCred, LigneDeb)
    Next x
Range([AH1], Cells(Rows.Count, "AH")).ClearContents
 
End Sub

j'ai essayé avec

Code:

If sum(c) > 0 Then

mais ca ne marche pas :(

20/04/2012, 13h45
Daniel.C

Bonjour,

J'ai un peu de mal...

Citation:

'Si la somme des valeurs "c" pour la meme date est positive alors

c représente une date. Que faut il additionner ?
20/04/2012, 14h16
sylvestre09

slt daniel je prend un exemple simple:
le 20/04/2012 ("c" ===> dans le code je suppose !!!)
on a 3 ligne dans le tableau ( 3 opérations) pour les montants [Cells(c.Row, 7)] et les taux [Cells(c.Row, 8)] suivants:
M:100 T: 0.5
M:-50 T: 1.5
M:-25 T: 1
au lieu de remplir le tableau selon le montant de chaque opération on remplie selon le total de chaque date c'est a dire dans le tableau on aura pour la date 20/04/2012 un total de 25 (=100-50-25) pour un taux de 1 (=(05+1.5+1)/3) et comme le montant est positif il remplie les cellules AR-AQ-AP
est ce plus clair ?
20/04/2012, 16h19
Daniel.C

S'il te plaît, envoie-moi un nouveau classeur. Dans mon classeur, en colonne 5, j'ai les échéances, en colonne 6, le nom de la devise et le taux est en colonne 7...
23/04/2012, 09h36
sylvestre09

1 pièce(s) jointe(s)

Bonjour Daniel dsl pour le retard !!
voilà le fichier avec un exemple :)

Bonjour,

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
Sub Pret_Emprunt()
    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, Dico As Object, Plage As Range
 
    ligne = 2
    Set Dico = Nothing
    Set Dico = CreateObject("Scripting.Dictionary")
         For Each c In Range([E4], Cells(Rows.Count, 5).End(xlUp))
           If Not Dico.exists(DateSerial(Year(c.Value), Month(c.Value), 1)) Then
             Dico.Add DateSerial(Year(c.Value), Month(c.Value), 1), _
                 DateSerial(Year(c.Value), Month(c.Value), 1)
         End If
    Next c
 
    i = 0
    For Each Item In Dico.items
        i = i + 1
        Cells(i, "AH") = Item
    Next Item
    [AH:AH].Sort Range("AH1"), xlAscending, Header:=xlNo
    For Each x In Range([AH1], Cells(Rows.Count, "AH").End(xlUp))
        Ctr = 0
        ligne = ligne + 2
        Cells(ligne, 40) = DateSerial(Year(x.Value), Month(x.Value), 1)
        Cells(ligne, 40).NumberFormat = "mmm-yyyy"
        LigneDeb = ligne
        LigneCred = ligne
        For Each c In Range([E4], Cells(Rows.Count, 5).End(xlUp))
            If DateSerial(Year(c.Value), Month(c.Value), 1) = Cells(ligne, 40) Then
                If Application.CountIf(Range([E4], c), c) = 1 Then
                    Set Plage = Range([E4], Cells(Rows.Count, 5).End(xlUp))
                    Somme = Evaluate("sumif(" & Plage.Address & "," & c.Address & "," & Plage.Offset(, 2).Address & ")")
                    Moyenne = Evaluate("averageif(" & Plage.Address & "," & c.Address & "," & Plage.Offset(, 3).Address & ")")
                    If Somme > 0 Then 'Si la somme des valeurs "c" pour la meme date est positive alors
                        Cells(LigneCred, "AR") = Cells(c.Row, 5)
                        Cells(LigneCred, "AQ") = Cells(c.Row, 8) 'la moyenne des valeurs de la colonne 8 correspondant à la somme de "c"
                        Cells(LigneCred, "AP") = Somme 'la somme des valeurs "c"
                        Ctr = Ctr + Somme
                        LigneCred = LigneCred + 1
                    Else
                        Cells(LigneDeb, "AM") = Cells(c.Row, 5)
                        Cells(LigneDeb, "AL") = Cells(c.Row, 8) 'la moyenne des valeurs de la colonne 8 correspondant à la somme de "c"
                        Cells(LigneDeb, "AK") = Somme 'la somme des valeurs "c"
                        Ctr = Ctr + Somme
                        LigneDeb = LigneDeb + 1
                    End If
                End If
            End If
        Next c
        Cells(ligne + 1, 40) = Ctr
        Cells(ligne + 1, 40).NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
        ligne = Application.Max(LigneCred, LigneDeb)
    Next x
Range([AH1], Cells(Rows.Count, "AH")).ClearContents
 
End Sub

23/04/2012, 12h54
sylvestre09

1 pièce(s) jointe(s)
Bonjour Daniel ecoute je travaille sur excel 2003 il reconnait pas la fonction averageif du coup ca bloque a ce niveau !
une autre question ici
Code:

1 2 Cells(LigneCred, "AQ") = Cells(c.Row, 8) Cells(LigneDeb, "AL") = Cells(c.Row, 8)
ce n'est pas plutot

Code:

Cells(LigneDeb, "AL") = Moyenne Cells(LigneDeb, "AQ") = Moyenne

??

Daniel en fait c'est encore plus compliqué que ça :(

J'espère que c'est ton dernier mot ;)

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
Sub Pret_Emprunt()
    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, Dico As Object, Plage As Range
 
    ligne = 2
    Set Dico = Nothing
    Set Dico = CreateObject("Scripting.Dictionary")
         For Each c In Range([E4], Cells(Rows.Count, 5).End(xlUp))
           If Not Dico.exists(DateSerial(Year(c.Value), Month(c.Value), 1)) Then
             Dico.Add DateSerial(Year(c.Value), Month(c.Value), 1), _
                 DateSerial(Year(c.Value), Month(c.Value), 1)
         End If
    Next c
 
    i = 0
    For Each Item In Dico.items
        i = i + 1
        Cells(i, "AH") = Item
    Next Item
    [AH:AH].Sort Range("AH1"), xlAscending, Header:=xlNo
    For Each x In Range([AH1], Cells(Rows.Count, "AH").End(xlUp))
        Ctr = 0
        ligne = ligne + 2
        Cells(ligne, 40) = DateSerial(Year(x.Value), Month(x.Value), 1)
        Cells(ligne, 40).NumberFormat = "mmm-yyyy"
        LigneDeb = ligne
        LigneCred = ligne
        Set Plage = Range([E4], Cells(Rows.Count, 5).End(xlUp))
        For Each c In Plage
            If DateSerial(Year(c.Value), Month(c.Value), 1) = Cells(ligne, 40) Then
                If Application.CountIf(Range([E4], c), c) = 1 Then
 
                    Somme = Evaluate("sumif(" & Plage.Address & "," & c.Address & "," & Plage.Offset(, 2).Address & ")")
                    interet = Evaluate("sumproduct((" & Plage.Address & "=" & c.Address & ")*abs(" & Plage.Offset(, 2).Address & ")*" & Plage.Offset(, 3).Address & "/100)")
                    Moyenne = Evaluate("sumproduct((" & Plage.Address & "=" & c.Address & ")*abs(" & Plage.Offset(, 2).Address & "))")
                    taux = interet / Moyenne * 100
                    If Somme > 0 Then 'Si la somme des valeurs "c" pour la meme date est positive alors
                        Cells(LigneCred, "AR") = Cells(c.Row, 5)
                        Cells(LigneCred, "AQ") = taux 'la moyenne des valeurs de la colonne 8 correspondant à la somme de "c"
                        Cells(LigneCred, "AP") = Somme 'la somme des valeurs "c"
                        Ctr = Ctr + Somme
                        LigneCred = LigneCred + 1
                    Else
                        Cells(LigneDeb, "AM") = Cells(c.Row, 5)
                        Cells(LigneDeb, "AL") = taux 'la moyenne des valeurs de la colonne 8 correspondant à la somme de "c"
                        Cells(LigneDeb, "AK") = Somme 'la somme des valeurs "c"
                        Ctr = Ctr + Somme
                        LigneDeb = LigneDeb + 1
                    End If
                End If
            End If
        Next c
        Cells(ligne + 1, 40) = Ctr
        Cells(ligne + 1, 40).NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
        ligne = Application.Max(LigneCred, LigneDeb)
    Next x
Range([AH1], Cells(Rows.Count, "AH")).ClearContents
 
End Sub

23/04/2012, 16h17
sylvestre09

tu es le meilleur Daniel :)
Merci !!
04/07/2012, 16h59
sylvestre09

1 pièce(s) jointe(s)

Bonjour Daniel !! je sais que j'exagère mais bon après un mois de test de mon programme mon patron vient de constater une anomalie au niveau des calculs j'ai beau essayé de modifier sans reussite. ca date un peu ce poste mais comme y'a toutes les données je me permet de te reecrire ici voilà je te joint un fichier pour t'expliquer j'attend ta proposition avec impatience Merci d'avance.
04/07/2012, 17h30
Daniel.C

Bonjour,

Est-ce que tu pourrais me rappeler ce qu'il faut faire ? J'ai tout oublié, et comme je n'ai pas commenté le code...
04/07/2012, 17h34
sylvestre09

a partir du premier tableau on va remplir le deuxieme tableau colonne (AK:AR)
pour chaque date d'echeance colonne E on va calculer le total (la somme des colonne G et la placer dans le deuxieme tableau selon le signe +ou-) et pour chaque date on va calculer le taux correspondant j'ai mis un commentaire dans la feuille2 (Exemple) pour t'expliquer la facon (trop compliqué) de calculer le taux :(
05/07/2012, 21h37
Daniel.C

Citation:

par contre quand on arrive à la ligne 5 notre somme devient positive alors là on prend l'autre taux donc 0,922

(ou 0,9922 ?) mais là, je ne comprends pas ce que tu veux dire. Après avoir traité la ligne 4, j'arrive à un taux de 1.36113358018438. Quel est le calcul à effectuer sur la ligne 5 ?

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