Aide retraitement en masse données - VBA
Bonsoir à tous,
Comptable en entreprise, je m'intéresse de plus au VBA qui me permet de gagner un temps fou sur des retraitements en tous genre.
Je rencontre actuellement un problème sur un fichier sur lequel je dois faire des retraitements en masse.
Le problème est que ce retraitement nécessite la définition de plusieurs variables (j'imagine) et je ne sais pas comment "matérialiser" tout cela.
Le problème est le suivi :
J'extrait un grand livre dont un tri est effectué par N° de pièce (facture).
Le grand livre nous renvoi alors pour chaque facture un compte 607 et un compte 401 et des quantités réciproques entre le compte 607 et le compte 401.
L'objectif du retraitement est de "vider" les montants contenus dans les lignes des comptes 607 et les additionner aux montants déjà présents en compte 401. Le critère de cette addition est la quantité de produit commandé.
Le sous total par facture ne varie donc pas puisque le montant contenu dans le compte 607 est supprimé (puisqu'il est additionné dans le 401).
Pour pouvoir faire l'addition, le compte 607 doit avec la même quantité de produit que le compte 401, sinon, j'estime que les sommes n'ont pas à être retraitées.
De plus, pour qu'Excel comprenne que les comptes 6xxxx doivent être retraités, je colorie les lignes à "vider" en orange.
Je vous joins un tableau sur lequel je mentionne un "Avant" et une feuille "Après retraitements".
Le total général ne doit bien évidemment pas bouger.
Est-il possible de faire ce retraitement en masse ?
Si vous avez besoin de plus d'explications, n'hésitez pas à me le demander.
Merci d'avance.
Bonne soirée,
Riri
Bonsoir Jers19,
Premièrement, merci infiniment pour votre réponse !
Je viens de regarder votre code, alors c'est parfait, ça marche très bien sur cet échantillon, je testerai demain sur ma base qui comporte plusieurs milliers d'entrées.
C'est vraiment en regardant votre code que je me rends compte que mes connaissances VBA sont pour le moment très limitées et que j'ai encore fort à faire pour progresser. En effet, je ne comprends pas grand chose de la macro
Pouvez-vous m'aider à l'interpréter ?
Sub Epur()
Dim LastLine As Integer
Dim i As Integer, j As Integer
[color=#0000FF]Ici, je comprends que vous définissez vos variables. A quoi sert de définir LastLine & i & j ?[/color]
LastLine = Range("B1").End(xlDown).Row
[color=#0040FF]Vous indiquez ici la dernière ligne, ok. Mais pourquoi ?[/color]
For i = 2 To LastLine
[color=#0040FF]Je crois que vous délimitez ici le tableau[/color]
If Left(Cells(i, 1).Value, 1) = "6" Then
[color=#0040FF] Une formule SI en VBA est appliquée ici, mais que fait elle ? Si ??? = 6 alors ??? --> Pourquoi 6 ?[/color]
For j = 2 To LastLine
If Left(Cells(j, 1).Value, 1) = "4" And Cells(i, 8).Value = Cells(j, 8).Value And Abs(Cells(i, 9).Value) = Abs(Cells(j, 9).Value) Then
Cells(j, 4).Value = Cells(j, 4).Value + Cells(i, 4).Value
Cells(j, 6).Value = Cells(j, 6).Value + Cells(i, 6).Value
Cells(i, 4).Value = ""
Cells(i, 6).Value = ""
[color=#0040FF] Vous m'avez définitivement perdu à cet endroit :-D Comment le code sait que les montants à additionner se trouvent en colonne D et F ? Comment fait il pour savoir que le critère est les quantités ?[/color]
Exit For
End If
Next j
End If
Next i
End SubPS : Je reviendrai vers vous demain dès que j'aurai testé la macro sur le fichier "grandeur nature".
J'en profiterai pour passer le post en "Résolu".
Bonne soirée
j'ai du mal à comprendre pourquoi tu veux additionner des montants de comptes de charges sur des comptes fournisseurs, mais bon, tu dois bien y trouver une utilité sinon tu ne poserais pas la question...!
une précision : avec la macro de Jers19, tu n'auras plus besoin de colorer les lignes de charges, le traitement se fera sur tous les comptes 6....
j'ai du mal à comprendre pourquoi tu veux additionner des montants de comptes de charges sur des comptes fournisseurs, mais bon, tu dois bien y trouver une utilité sinon tu ne poserais pas la question...!
une précision : avec la macro de Jers19, tu n'auras plus besoin de colorer les lignes de charges, le traitement se fera sur tous les comptes 6....
Très bonne question
J'ai volontairement modifié les comptes pour une question de confidentialité
quelques explications sommaires sur son code, suite à ta demande :
- Lastline est la variable qu'il a défini pour détecter la dernière ligne à traiter dans ton export de grand livre (= jusqu'où effectuer le traitement)
- i et j sont des variables de numéro de ligne, et servent chacune à passer les lignes en revue une à une
- sa formule IF sert à détecter un "6" ou un "4" dans le numéro du compte général (plus précisément, sur le 1er caractère en partant de la gauche du compte)
Merci pour votre réponse.
Pour les variables i & j, aurai-je pu les renommer en x & y ? ou abc & def ?
Comment la macro sait où chercher les montants ? Je ne vois pas de recherche dans les colonnes D & F
Bonne nuit
Pour les variables i & j, aurai-je pu les renommer en x & y ? ou abc & def ?
oui
de préférence des noms qui te "parlent" si tu n'es pas très à l'aise avec les variables ou les macros
Comment la macro sait où chercher les montants ? Je ne vois pas de recherche dans les colonnes D & F
Cells(j, 4).Value => valeur stockée dans la cellule de la ligne j, colonne 4 (=D)
Cells(j, 6).Value => valeur stockée dans la cellule de la ligne j, colonne 6 (=F)
tu peux remplacer par Range("D" & j).Value et Range("F" & j).Value si tu préfère, cela reviendra exactement au même, et sera peut être plus lisible pour toi
il y a différentes façons d'appeler les références de cellules, l'ordre des coordonnées n'est pas la même entre Cells() et Range() ...
Je vous remercie ! C'est bien plus clair pour moi.
Je n'avais effectivement pas compris que 4 & 6 étaient des références à mes colonnes.
J'adapte le code sur mon fichier et je teste le tout.
Je vous tiendrai au courant du résultat.
Merci à vous !
Je viens de tester et adapter la macro à mon fichier et je rencontre un problème :
Je constate que la macro ne fait pas son travail « par facture » mais sur l’intégralité du fichier.
De ce fait, il peut exister (pour une facture) des comptes 6xxxx sans contrepartie derrière (pas de 4xxx en face) et si la macro trouve des contreparties (4xxxx) dans une autre facture avec les mêmes articles et quantités, elle remplace les données des 6xxx d’une facture N° 1 vers les 4xxxx d’une autre facture.
Comment délimiter la macro pour qu’elle fasse son travail « par facture » ?
En effet, il ne doit pas y avoir de mouvement de chiffres ENTRE les factures. (Si une facture comporte uniquement des comptes 6xxx et pas de 4xxxx, alors on ne fait rien et on passe à la suivante).
Est-ce possible de délimiter ce travail par facture ? Je pense à un genre de (FOR EACH « Numéro pièce »)
Merci à vous.
Salut,
Il faut que tu remplaces cette ligne de code. En considérant que ton numéro de facture est en colonne B (correspond à la colonne 2)
If Left(Cells(j, 1).Value, 1) = "4" And Cells(i, 8).Value = Cells(j, 8).Value And Abs(Cells(i, 9).Value) = Abs(Cells(j, 9).Value) Thenpar
If Left(Cells(j, 1).Value, 1) = "4" And Cells(i, 2).Value = Cells(j, 2).Value And Cells(i, 8).Value = Cells(j, 8).Value And Abs(Cells(i, 9).Value) = Abs(Cells(j, 9).Value) ThenMerci encore pour cette bonne réponse !
J’ai adapté le code et tout fonctionne correctement.
Encore un dernier problème (mineur), il peut arriver que pour une même facture, on retrouve deux fois une ligne 6xxx comportant un Article et une Quantité identique et deux fois des lignes 4xxxx avec les mêmes Article et Quantité.
Le code comprend maintenant qu’il faut faire le retraitement par facture mais comment lui faire comprendre qu’une fois qu’une ligne 6xxx a été retraitée dans le compte 4xxx, il faut passer à la deuxième ligne ? (identique).
Pour le moment la macro prend les deux lignes 6xxx identiques et retraite directement dans la première ligne des 4xxx alors qu’il faudrait éclater ce retraitement dans chaque 4xxx (1+1 ligne).
Je ne sais pas si je suis clair…
Salut,
Tu peux essayer cela.
L'idée est de stocker dans un tableau les numéros de lignes déjà modifiées afin de les modifier qu'une seule fois.
On espérant que cela te convienne.
Je n'ai pas tester, je te laisse le soin de le faire.
A+
Bonsoir Jers19, Riri5665, le forum
Teste ceci
Option Explicit
Sub test()
Dim dico As Object, a, i As Long, txt As String
Set dico = CreateObject("Scripting.Dictionary")
dico.CompareMode = 1
Application.ScreenUpdating = False
With Sheets(1).Range("a1").CurrentRegion
a = .Value
For i = 2 To UBound(a, 1)
If Left(a(i, 1), 1) = 6 Then
txt = Join$(Array(a(i, 2), a(i, 8), Abs(a(i, 9))), "|")
If Not dico.exists(txt) Then
Set dico(txt) = _
CreateObject("Scripting.Dictionary")
End If
dico(txt)(i) = VBA.Array(a(i, 4), a(i, 6))
End If
Next
For i = 2 To .Rows.Count
If Left(.Cells(i, 1).Value, 1) = 4 Then
txt = Join$(Array(.Cells(i, 2).Value, .Cells(i, 8).Value, Abs(.Cells(i, 9).Value)), "|")
If dico.exists(txt) Then
If dico(txt).Count > 0 Then
.Cells(i, 4).Value = .Cells(i, 4).Value + dico(txt).items()(0)(0)
.Cells(i, 6).Value = .Cells(i, 6).Value + dico(txt).items()(0)(1)
.Cells(dico(txt).keys()(0), 4).Value = 0
.Cells(dico(txt).keys()(0), 6).Value = 0
dico(txt).Remove dico(txt).keys()(0)
End If
End If
End If
Next
End With
Application.ScreenUpdating = True
Set dico = Nothing
End Subklin89
Re Riri5665,
Pour le fun
Option Explicit
Sub test_Queue()
Dim dico As Object, a, i As Long, txt As String
Set dico = CreateObject("Scripting.Dictionary")
dico.CompareMode = 1
Application.ScreenUpdating = False
With Sheets(1).Range("a1").CurrentRegion
a = .Value
For i = 2 To UBound(a, 1)
If Left(a(i, 1), 1) = 6 Then
txt = Join$(Array(a(i, 2), a(i, 8), Abs(a(i, 9))), "|")
If Not dico.exists(txt) Then
Set dico(txt) = _
CreateObject("System.Collections.Queue")
End If
dico(txt).Enqueue VBA.Array(i, a(i, 4), a(i, 6))
End If
Next
For i = 2 To .Rows.Count
If Left(.Cells(i, 1).Value, 1) = 4 Then
txt = Join$(Array(.Cells(i, 2).Value, .Cells(i, 8).Value, Abs(.Cells(i, 9).Value)), "|")
If dico.exists(txt) Then
If dico(txt).Count > 0 Then
.Cells(i, 4).Value = .Cells(i, 4).Value + dico(txt).Peek()(1)
.Cells(i, 6).Value = .Cells(i, 6).Value + dico(txt).Peek()(2)
.Cells(dico(txt).Peek()(0), 4).Value = 0
.Cells(dico(txt).Peek()(0), 6).Value = 0
dico(txt).Dequeue
End If
End If
End If
Next
End With
Application.ScreenUpdating = True
Set dico = Nothing
End SubOu celle-ci :
Option Explicit
Sub test_ArrayList()
Dim dico As Object, a, i As Long, txt As String
Set dico = CreateObject("Scripting.Dictionary")
dico.CompareMode = 1
Application.ScreenUpdating = False
With Sheets(1).Range("a1").CurrentRegion
a = .Value
For i = 2 To UBound(a, 1)
If Left(a(i, 1), 1) = 6 Then
txt = Join$(Array(a(i, 2), a(i, 8), Abs(a(i, 9))), "|")
If Not dico.exists(txt) Then
Set dico(txt) = _
CreateObject("System.Collections.ArrayList")
End If
dico(txt).Add VBA.Array(i, a(i, 4), a(i, 6))
End If
Next
For i = 2 To .Rows.Count
If Left(.Cells(i, 1).Value, 1) = 4 Then
txt = Join$(Array(.Cells(i, 2).Value, .Cells(i, 8).Value, Abs(.Cells(i, 9).Value)), "|")
If dico.exists(txt) Then
If dico(txt).Count > 0 Then
.Cells(i, 4).Value = .Cells(i, 4).Value + dico(txt).Item(0)(1)
.Cells(i, 6).Value = .Cells(i, 6).Value + dico(txt).Item(0)(2)
.Cells(dico(txt).Item(0)(0), 4).Value = 0
.Cells(dico(txt).Item(0)(0), 6).Value = 0
dico(txt).removeat 0
End If
End If
End If
Next
End With
Application.ScreenUpdating = True
Set dico = Nothing
End Subklin89
Bonsoir,
J'ai testé et adapté vos codes à mon fichier et cela fonctionne très bien.
Merci pour votre aide.
Bonne soirée
Bonsoir à tous,
Je me permets de remonter le sujet, en réessayant vos dernières macros, j'ai du décaler un truc et je ne parviens plus à adapter vos travaux sur mon fichier. Je me mélange les pinceaux avec les variables et les numéros des colonnes.
Je vous ai joint une nouvelle version de mon fichier qui correspond au fichier réel en terme de colonnes.
Merci de votre aide !
Re Riri5665
C'est pourtant pas compliqué
Option Explicit
Sub test_ArrayList()
Dim dico As Object, a, i As Long, txt As String
Set dico = CreateObject("Scripting.Dictionary")
dico.CompareMode = 1
Application.ScreenUpdating = False
With Sheets(1).Range("a1").CurrentRegion
a = .Value
For i = 2 To UBound(a, 1)
If Left(a(i, 1), 1) = 6 Then
txt = Join$(Array(a(i, 5), a(i, 16), Abs(a(i, 17))), "|")
If Not dico.exists(txt) Then
Set dico(txt) = _
CreateObject("System.Collections.ArrayList")
End If
dico(txt).Add VBA.Array(i, a(i, 12), a(i, 14))
End If
Next
For i = 2 To .Rows.Count
If Left(.Cells(i, 1).Value, 1) = 4 Then
txt = Join$(Array(.Cells(i, 5).Value, .Cells(i, 16).Value, Abs(.Cells(i, 17).Value)), "|")
If dico.exists(txt) Then
If dico(txt).Count > 0 Then
.Cells(i, 12).Value = .Cells(i, 12).Value + dico(txt).Item(0)(1)
.Cells(i, 14).Value = .Cells(i, 14).Value + dico(txt).Item(0)(2)
.Cells(dico(txt).Item(0)(0), 12).Value = 0
.Cells(dico(txt).Item(0)(0), 14).Value = 0
dico(txt).removeat 0
End If
End If
End If
Next
End With
Application.ScreenUpdating = True
Set dico = Nothing
End SubAttention à ce que la plage à traiter soit bien prise en compte, j'utilise la propriété CurrentRegion
Cela se traduit au clavier manuellement par Crtl + *
klin89
Salut,
Voici la modif demandée
Sub Epur()
Dim LastLine As Integer
Dim i As Integer, j As Integer, k As Integer, p As Integer
Dim TabDejaTraite()
LastLine = Range("E1").End(xlDown).Row
ReDim TabDejaTraite(1 To 1)
k = 1
p = 1
For i = 2 To LastLine
If Left(Cells(i, 1).Value, 1) = "6" Then
For j = 2 To LastLine
If Left(Cells(j, 1).Value, 1) = "4" And Cells(i, 5).Value = Cells(j, 5).Value _
And Cells(i, 16).Value = Cells(j, 16).Value And Abs(Cells(i, 17).Value) = Abs(Cells(j, 17).Value) Then
Doublons = False
For k = 1 To UBound(TabDejaTraite)
If TabDejaTraite(k) = j Then
Doublons = True
Exit For
End If
Next k
If Doublons = False Then
Cells(j, 12).Value = Cells(j, 12).Value + Cells(i, 12).Value
Cells(j, 14).Value = Cells(j, 14).Value + Cells(i, 14).Value
Cells(i, 12).Value = ""
Cells(i, 14).Value = ""
TabDejaTraite(p) = j
p = p + 1
ReDim Preserve TabDejaTraite(1 To p)
Exit For
End If
End If
Next j
End If
Next i
End SubA+
Bonsoir !
Je viens de tester le code et cela fonctionne !
Merci énormément à vous deux!