Comparaison d'unede deux périodes à partir d'une même clé

momo

XLDnaute Occasionnel
Bonjour à tous,

Je voudrais demander une faveur

j'ai un fichier ou je fais des comparaisons sur deux années pour un même clé de recherche

lorsque les variation dépassent un certain seuil je voudrais m'expliquer le détail de ce qui cause cete variation. Ce détails se trouve dans un autre onglet.

Je voudrais donc que par VBA si possible, lorsque la variation dépasse le seuil pour une clé de recherche; ma macro puisse aller chercher les infos pour cette clé dans les onglets détails de tous les comptes et puisse faire une variation

je joins un fichier afin de mieux expliquer ma demande


je vous remercie par avance et bonne journée dominicale
 

Pièces jointes

  • Comparaison à partir d'une même clé.xlsx
    19.4 KB · Affichages: 52
  • Comparaison à partir d'une même clé.xlsx
    19.4 KB · Affichages: 52

momo

XLDnaute Occasionnel
Re : Comparaison d'unede deux périodes à partir d'une même clé

Bonsoir Le forum; Bonsoir Sousou

Franchement On approche de la vérité

Le travail que vous faites est génial

1 premier Point

Il faudrait que l'onglet détail qui se génère après double clik sur le compte se presente aussi comme sur le modele de la feuille synthèse pour qu'on voie directement là ou sont nées les écarts

2e point

Dans le détail qui se génère actu les données de 2015 n'apparaissent pas.
 

klin89

XLDnaute Accro
Re : Comparaison d'unede deux périodes à partir d'une même clé

Re à tous,

Avec le fichier de sousou post#14, cette macro pour effectuer la synthèse.
VB:
Option Explicit

Sub test()
Dim a, i As Long, w(), e
    a = Sheets("2014").Range("a1").CurrentRegion.Resize(, 3).Value
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 1 To UBound(a, 1)
            a(i, 1) = CStr(a(i, 1))
            If Not .exists(a(i, 1)) Then
                .Item(a(i, 1)) = VBA.Array(a(i, 1), a(i, 3), Empty, Empty)
            Else
                w = .Item(a(i, 1)): w(1) = w(1) + a(i, 3)
                .Item(a(i, 1)) = w
            End If
        Next
        a = Sheets("2015").Range("a1").CurrentRegion.Resize(, 3).Value
        For i = 1 To UBound(a, 1)
            a(i, 1) = CStr(a(i, 1))
            If Not .exists(a(i, 1)) Then
                .Item(a(i, 1)) = VBA.Array(a(i, 1), Empty, a(i, 3), Empty)
            Else
                w = .Item(a(i, 1)): w(2) = w(2) + a(i, 3)
                .Item(a(i, 1)) = w
            End If
        Next
        For Each e In .keys
            w = .Item(e)
            w(3) = w(2) - w(1)
            .Item(e) = w
        Next
        a = .items: i = .Count
    End With
    Application.ScreenUpdating = False
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("Synthese").Delete
    On Error GoTo 0
    Sheets.Add(after:=Sheets(Sheets.Count)).Name = "Synthese"
    Sheets("Synthese").Cells(1).Resize(1, 4).Value = Array("Comptes", "2014", "2015", "Variation")
    Sheets("Synthese").Cells(1).Offset(1).Resize(i, 4).Value = Application.Index(a, 0, 0)
    With Sheets("Synthese").Cells(1).CurrentRegion
        .Sort key1:=.Cells(1), order1:=1, Header:=xlYes
        .Font.Name = "calibri"
        .Font.Size = 10
        .VerticalAlignment = xlCenter
        .BorderAround Weight:=xlThin
        .Borders(xlInsideVertical).Weight = xlThin
        With .Rows(1)
            .BorderAround Weight:=xlThin
            .Interior.ColorIndex = 38
        End With
        .Columns.AutoFit
    End With
    Application.ScreenUpdating = True
End Sub
Concernant l'affichage du détail, on remerciera sousou parti en éclaireur :rolleyes:
momo, c'est quand même pas compliqué d'afficher le résultat souhaité sur une autre feuille.

klin89
 
Dernière édition:

momo

XLDnaute Occasionnel
Re : Comparaison d'unede deux périodes à partir d'une même clé

Merci Klin89 pour toute la peine que tu t'e donnée... Ca fait vraiment plaisir de voir ce genre d'élan de solidaririté

Je pense que dans le poste 15 de sousou il a lui aussi déjà Produit une macro donnant le même résultat....

Donc comme tu l'as si bien dit On remercie Sousou pour le travail en cours pr l'affichage du détail
 

sousou

XLDnaute Barbatruc
Re : Comparaison d'unede deux périodes à partir d'une même clé

bonjour
Une nouvelle version
Merci de valider les résultats et de répondre sur l'histoire du signe "-"
 

Pièces jointes

  • Même clé3.xlsm
    41.1 KB · Affichages: 33
  • Même clé3.xlsm
    41.1 KB · Affichages: 35

momo

XLDnaute Occasionnel
Re : Comparaison d'unede deux périodes à partir d'une même clé

Bonjour Sousou

Merci pour le retour

Par rapport aux signes "-" c'est normal c'est des montants qui peuvent revenir en négatifs. Avec le même numéro account sur deux années différentes le signe peut rester négatifs comme il peut passer du négatif au positif et vice versa

Par contre je joins un fichier qui montre comment devrait se présenter la feuille détail lorsqu'on clique sur un numéro de compte
 

Pièces jointes

  • Même clé3.xlsm
    30.6 KB · Affichages: 42
  • Même clé3.xlsm
    30.6 KB · Affichages: 38

momo

XLDnaute Occasionnel
Re : Comparaison d'unede deux périodes à partir d'une même clé

Ahahaha Merci Sousou c'est Génial!!!! On est y enfin arrivé!!!! Ca marche ne reste que la forme......

Par contre Le temps d'exécution est ce qu'on peut le réduire.. Sur une base très importante ca va ramer un Max
 

sousou

XLDnaute Barbatruc
Re : Comparaison d'unede deux périodes à partir d'une même clé

re
faut voir
Avec tous ces allez retour, je n'ai pas optimisé grand chose.
Le tout était de savoir quel résultat ont cherche
Je vais essayer de voir maintenant que je sais où on va .
la semaine prochaine sans doute

Mais as-tu vérifié la cohérence et la validité des résultats??
 

momo

XLDnaute Occasionnel
Re : Comparaison d'unede deux périodes à partir d'une même clé

Ca me va totalement... Je patienterai next week pour le fichier final

Oui oui j'ai vérifié tout semblait correct....le rapprochement date à date en fonction de la colone Account marche parfaitement
 

klin89

XLDnaute Accro
Re : Comparaison d'unede deux périodes à partir d'une même clé

Re à tous,:)

Vous parlez de clés et de sous clés au post #15.
Donc on peut associer un dictionnaire comme élément du dictionnaire principal.

Restitution en Feuil1, feuille préalablement créée.
Ensuite, tu peux filtrer en colonne A pour rechercher le compte souhaité.
VB:
Option Explicit

Sub test()
Dim a, i As Long, n As Long, y, e, w, s
    a = Sheets("2014").Range("a1").CurrentRegion.Resize(, 3).Value
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 1 To UBound(a, 1)
            a(i, 1) = CStr(a(i, 1)): a(i, 2) = CStr(a(i, 2))
            If Not .exists(a(i, 1)) Then
                Set .Item(a(i, 1)) = _
                CreateObject("Scripting.Dictionary")
                .Item(a(i, 1)).CompareMode = 1
            End If
            .Item(a(i, 1))(a(i, 2)) = _
            VBA.Array(a(i, 1), a(i, 2), a(i, 3), Empty, Empty)
        Next
        a = Sheets("2015").Range("a1").CurrentRegion.Resize(, 3).Value
        For i = 1 To UBound(a, 1)
            a(i, 1) = CStr(a(i, 1)): a(i, 2) = CStr(a(i, 2))
            If Not .exists(a(i, 1)) Then
                Set .Item(a(i, 1)) = _
                CreateObject("Scripting.Dictionary")
                .Item(a(i, 1)).CompareMode = 1
            End If
            If Not .Item(a(i, 1)).exists(a(i, 2)) Then
                .Item(a(i, 1))(a(i, 2)) = _
                VBA.Array(a(i, 1), a(i, 2), Empty, a(i, 3), Empty)
            Else
                w = .Item(a(i, 1))(a(i, 2))
                w(3) = a(i, 3)
                .Item(a(i, 1))(a(i, 2)) = w
            End If
        Next
        For Each e In .keys
            For Each s In .Item(e).keys
                w = .Item(e)(s)
                w(4) = w(3) - w(2)
                .Item(e)(s) = w
            Next
        Next
        y = .items
    End With
    'Restitution et mise en forme
    Application.ScreenUpdating = False
    With Sheets("Feuil1")
        n = 1
        .Cells.Clear
        .Columns("b").NumberFormat = "@"
        With .Cells(1)
            .Resize(1, 5).Value = Array("Comptes", "Account", "2014", "2015", "Variation")
            For i = 0 To UBound(y)
                With .Offset(n).Resize(y(i).Count, 5)
                    .Value = _
                    Application.Transpose(Application.Transpose(y(i).items))
                    n = n + .Rows.Count
                End With
            Next
            With .CurrentRegion
                .Font.Name = "calibri"
                .Font.Size = 10
                .VerticalAlignment = xlCenter
                .BorderAround Weight:=xlThin
                .Borders(xlInsideVertical).Weight = xlThin
                With .Offset(1).Resize(.Rows.Count - 1)
                    .Columns("c:e").NumberFormat = _
                    "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
                End With
                With .Rows(1)
                    .BorderAround Weight:=xlThin
                    .Interior.ColorIndex = 38
                    .HorizontalAlignment = xlCenter
                End With
                .Columns.AutoFit
            End With
        End With
        .Activate
    End With
    Application.ScreenUpdating = True
End Sub
Avec ce code, tu pourrais créer autant de feuilles que de comptes existants.
klin89
 

sousou

XLDnaute Barbatruc
Re : Comparaison d'unede deux périodes à partir d'une même clé

Bonjour
Dans un premier temps
ajoute
application.ScreenUpdating=false en débute de procédure detail(......)
et
application.Screenupdating=true en fin de la même procédure

Et voir si cela te conviens
 

momo

XLDnaute Occasionnel
Re : Comparaison d'unede deux périodes à partir d'une même clé

Bonjour Sousou

Je viens de mettre les petites corrections. Ca n'améliore pas plus que ça la rapidité

Par contre je viens d'essayer de cliquer sur le compte: 553115400 et 553911000 ils m'envoient un message d'erreur et le débobage me souligne cette ligne While deb.Offset(n, 0) = deb

Alors que les autres donnent le résultat correct
 

Discussions similaires

Statistiques des forums

Discussions
312 502
Messages
2 089 049
Membres
104 012
dernier inscrit
baffyt2