Budget / compilation de certaines lignes et extraction vers un autre onglet

GADENSEB

XLDnaute Impliqué
Bonjour Le Forum,
Je reviens avec mon fichier de budget personnel.

J'ai pas eu de succès sur dévelloppez.com, comme je connais votre talent, j'essaye ici aussi !

Là je souhaite faire une opération un peu compliquée :

Je vais essayer de décrire plus en détail mon besoin :
Je souhaite faire l’opération d’analyse (comme un TCD) de toutes LIGNE (Onglet « COMPTES », Colonne I)
En faisant la différence pour REEL – BUDGET (calcul sur la colonne R)

Les données se trouvant dans l'onglet COMPTES dans les cellule colonnes A à T sur environ 2000 lignes actuellement, le nombre de lignes augmentant au fur et a mesure du temps.

Selon les critères suivants :
Pour les données REEL (il y a une zone de critères appelée : AreacriteraReel, dans l’onglet PARAMETRES)
Filtres 1.PNG

Pour les données BUDGET (il y a une zone de critères appelée : Areacriterabudget, dans l’onglet PARAMETRES)
Filtres 2.PNG


Pour Exemples :

Les calculs se font à Fin.mois-1 donc comme on est le 26/01/2015 -> les calculs se font jusqu’à fin Décembre 2015 (31/12/2015)
Les calculs se font sur la Colonne R « DEBITCREDIT » de l’onglet « COMPTES »)
Le cumul se fait pour chaque item de la colonne I « LIGNE »

Pour la ligne « COURSES » :

Le total REEL se monte à 436.95 €
Le total BUDGET se monte à 405€
Soit une Différence de + 31.95 €

Pour la ligne « INTERNET » :

Le total REEL se monte à 30 €
Le total BUDGET se monte à 40
Soit une Différence de - 10 €

--> Ce qui m’intéresse c’est tous les calculs qui font apparaitre une différence (+ ou-) différente de 0
--> Et extraire toutes ces LIGNE dans l’onglet INTERFACE sur l’emplacement I7 à J…..

EXTRACT.PNG

J'espére que j'ai était clair sur mon besoin

si qqn à une idée ...



Bonne journée
Seb
 

Fichiers joints

Paf

XLDnaute Barbatruc
Re : Budget / compilation de certaines lignes et extraction vers un autre onglet

Bonjour

Si j'ai bien tout compris (?) , un essai par macro:

Code:
Sub ListDifference()
 Dim MonTab, Tablo, TabTemp, i As Long
 Dim DicoList
 Set DicoList = CreateObject("Scripting.Dictionary")

 With Worksheets("PARAMETRES")
 Tablo = .Range("B2:B" & .Range("B" & Rows.Count).End(xlUp).Row)
 End With
 For i = LBound(Tablo) To UBound(Tablo)
     DicoList(Tablo(i, 1)) = 0
 Next

 datefin = DateSerial(Year(Date), Month(Date), 0) 'fin de mois du mois précédent
 With Worksheets("COMPTES")
 MonTab = .Range("A2:S" & .Range("A" & Rows.Count).End(xlUp).Row)
 End With
 For i = LBound(MonTab) To UBound(MonTab)
    If MonTab(i, 2) <= datefin Then
        If MonTab(i, 5) = "BUDGET" Then DicoList(MonTab(i, 9)) = CDbl(DicoList(MonTab(i, 9))) - CDbl(MonTab(i, 18))
        If MonTab(i, 5) = "REEL" Then DicoList(MonTab(i, 9)) = CDbl(DicoList(MonTab(i, 9))) + CDbl(MonTab(i, 18))
    End If
 Next

 For Each clé In DicoList.keys
    If DicoList(clé) = 0 Then DicoList.Remove (clé)
 Next
 With Worksheets("INTERFACE")
 TabTemp = Application.Transpose(Array(DicoList.keys, DicoList.Items))
 .Range("A8").Resize(UBound(TabTemp), 2) = TabTemp 'emplacement à adapter
 End With

End Sub
en additionnant les REEL et soustrayant les BUDGET j'obtiens
pour la ligne « COURSES » : une Différence de - 31.95
pour la ligne « INTERNET » : une Différence de + 10

A+
 

GADENSEB

XLDnaute Impliqué
Re : Budget / compilation de certaines lignes et extraction vers un autre onglet

Excellent !!!
J'adore.

Merci à toi.
Je fonce tester cela ;-)

Bonne am
 

GADENSEB

XLDnaute Impliqué
Re : Budget / compilation de certaines lignes et extraction vers un autre onglet

Me revoila !

J'adore ton code, simple et efficace : Quel talent !



J'ai une modif
J'ai inversé les + et le - sur les sur les CDBL (plus simple pour moi au niveau lecture) ;-)
Code:
        If MonTab(i, 5) = "BUDGET" Then DicoList(MonTab(i, 9)) = CDbl(DicoList(MonTab(i, 9))) - CDbl(MonTab(i, 18))
        If MonTab(i, 5) = "REEL" Then DicoList(MonTab(i, 9)) = CDbl(DicoList(MonTab(i, 9))) + CDbl(MonTab(i, 18))

J'ai fait une modif
J'ai remplacé A8 par I8 car cela s'adapte mieux à mon besoin ;-)
Code:
With Worksheets("INTERFACE")
 TabTemp = Application.Transpose(Array(DicoList.keys, DicoList.Items))
 .Range("I8").Resize(UBound(TabTemp), 2) = TabTemp 'emplacement à adapter
 End With

End Sub

---->J'ai rajouter un niveau de filtre sur la Colonne F sur le mot "COURANT"

Code:
 For i = LBound(MonTab) To UBound(MonTab)
    If MonTab(i, 2) <= datefin Then
    If MonTab(i, 6) = "COURANT" Then
        If MonTab(i, 5) = "BUDGET" Then DicoList(MonTab(i, 9)) = CDbl(DicoList(MonTab(i, 9))) + CDbl(MonTab(i, 18))
        If MonTab(i, 5) = "REEL" Then DicoList(MonTab(i, 9)) = CDbl(DicoList(MonTab(i, 9))) - CDbl(MonTab(i, 18))
    End If
    End If
 Next
encore merci tout est parfait !!!




bonne am, A bientôt

Seb
 
Dernière édition:

GADENSEB

XLDnaute Impliqué
Re : Budget / compilation de certaines lignes et extraction vers un autre onglet

Re moi

Je vais jouer mon pénible mais peut-on classer par ordre alphabetique les données qui sont extraites ?

Je suppose qu'il faut faire un classement sur MonTab(i, 5) !

Bonne am
Seb
 

Paf

XLDnaute Barbatruc
Re : Budget / compilation de certaines lignes et extraction vers un autre onglet

re,

les données extraites sont dans le tableau TabTemp, c'est donc lui qu'il faut trier. Ici avec un basique tri à bulle pas très performant mais vu le nombre de lignes à trier ce n'est pas sensible.

la fin du code modifiée pour trier les différences, si elles existent, dans l'ordre alphabétique , et si elles n'existent pas on affiche "Aucune différence" :

Code:
 For Each clé In DicoList.keys
    If DicoList(clé) = 0 Then DicoList.Remove (clé)
 Next
 With Worksheets("INTERFACE")
 If DicoList.Count > 0 Then  ' s'il existe des lignes avec différence
    TabTemp = Application.Transpose(Array(DicoList.keys, DicoList.Items))
    Do
    For i = LBound(TabTemp) To UBound(TabTemp) - 1
        Trié = True
        If TabTemp(i, 1) > TabTemp(i + 1, 1) Then
            tmp = TabTemp(i, 1)
            tmp2 = TabTemp(i, 2)
            TabTemp(i, 1) = TabTemp(i + 1, 1)
            TabTemp(i, 2) = TabTemp(i + 1, 2)
            TabTemp(i + 1, 1) = tmp
            TabTemp(i + 1, 2) = tmp2
            Trié = False
        End If
    Next i
    Loop Until Trié = True
    .Range("I8").Resize(UBound(TabTemp), 2) = TabTemp 'emplacement à adapter
 Else
    .Range("I8") = "Aucune différence"
 End If
 End With
A+
 

GADENSEB

XLDnaute Impliqué
Re : Budget / compilation de certaines lignes et extraction vers un autre onglet

Hello

Merci !

Le tri ne s’opère pas ...

J'ai replacé tout le code définitif, si tu vois qqc je suis preneur.


Merci bonne journée


Code:
Sub ListDifference()
 Dim MonTab, Tablo, TabTemp, i As Long
 Dim DicoList
 Set DicoList = CreateObject("Scripting.Dictionary")

With Worksheets("INTERFACE")
Range("I8:K" & .Range("J" & Rows.Count).End(xlUp).Row).ClearContents
End With

 With Worksheets("PARAMETRES")
 Tablo = .Range("B2:B" & .Range("B" & Rows.Count).End(xlUp).Row)
 End With
 For i = LBound(Tablo) To UBound(Tablo)
     DicoList(Tablo(i, 1)) = 0
 Next

 datefin = DateSerial(Year(Date), Month(Date), 0) 'fin de mois du mois précédent
 With Worksheets("COMPTES")
 MonTab = .Range("A2:S" & .Range("A" & Rows.Count).End(xlUp).Row)
 End With
 For i = LBound(MonTab) To UBound(MonTab)
    If MonTab(i, 2) <= datefin Then
    If MonTab(i, 6) = "COURANT" And MonTab(i, 8) <> "RESERVES" Then
        If MonTab(i, 5) = "BUDGET" Then DicoList(MonTab(i, 9)) = CDbl(DicoList(MonTab(i, 9))) + CDbl(MonTab(i, 18))
        If MonTab(i, 5) = "REEL" Then DicoList(MonTab(i, 9)) = CDbl(DicoList(MonTab(i, 9))) - CDbl(MonTab(i, 18))
    End If
    End If
 Next


For Each clé In DicoList.keys
    If DicoList(clé) = 0 Then DicoList.Remove (clé)
 Next
 With Worksheets("INTERFACE")
 If DicoList.Count > 0 Then  ' s'il existe des lignes avec différence
    TabTemp = Application.Transpose(Array(DicoList.keys, DicoList.Items))
    Do
    For i = LBound(TabTemp) To UBound(TabTemp) - 1
        Trié = True
        If TabTemp(i, 1) > TabTemp(i + 1, 1) Then
            tmp = TabTemp(i, 1)
            tmp2 = TabTemp(i, 2)
            TabTemp(i, 1) = TabTemp(i + 1, 1)
            TabTemp(i, 2) = TabTemp(i + 1, 2)
            TabTemp(i + 1, 1) = tmp
            TabTemp(i + 1, 2) = tmp2
            Trié = False
        End If
    Next i
    Loop Until Trié = True
    .Range("I8").Resize(UBound(TabTemp), 2) = TabTemp 'emplacement à adapter
 Else
    .Range("I8") = "Aucune différence"
 End If
 End With


End Sub
 

Paf

XLDnaute Barbatruc
Re : Budget / compilation de certaines lignes et extraction vers un autre onglet

re,

Rrrrrr ! Ben oui ... !!!

Juste déplacer la ligne
Code:
Trié = True
juste avant la ligne
Code:
For i = LBound(TabTemp) To UBound(TabTemp) - 1

A+
 

GADENSEB

XLDnaute Impliqué
Re : Budget / compilation de certaines lignes et extraction vers un autre onglet

Re !!
Ton code est vraiment au top !!!
Il me manque qu'un truc trier le range

MonTab = .Range("A2:S" & .Range("A" & Rows.Count).End(xlUp).Row)

Par la colonne B (dates), en ascendant.

J'ai testé plusieurs trucs différents mais a chaque fois je fou en l'air ma Bdd.... tu aurais une idée?

Bonne journée
Seb
 

Paf

XLDnaute Barbatruc
Re : Budget / compilation de certaines lignes et extraction vers un autre onglet

Re bonjour,

je ne comprend pas bien le souci !

a quoi peut bien servir de trier le 'range' MonTab = .Range("A2:S" & .Range("A" & Rows.Count).End(xlUp).Row)?
cette instruction permet juste de 'monter' en mémoire les données de la feuille pour gagner en temps d'exécution, elle n'affecte pas la base de données;

Pour trier la base de données une solution consiste à y appliquer une filtre automatique, puis sur la colonne B choisir Tri croissant.

A+
 

GADENSEB

XLDnaute Impliqué
Re : Budget / compilation de certaines lignes et extraction vers un autre onglet

Hello !!!
Mes excuses..... je me suis planté...
C'est pas sur ce code que je faire un tri par date ....
sorry

En tt cas merci pour le code !


Bonne journée
Seb
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas