SOMME des doublons sur Feuil1 et Feuil2 en VBA
Bonjour,
Pourriez-vous s'il vous plait m'aider à faire la somme des doublons sur mes deux feuilles 1 et 2 quand ce doublons est la même année?
Il y a un code VBA qui fonctionne mais les doublons présentent un souci.
Les critères sont :
Feuil1 : Chaine1 = col1 & col2 & col3 & col4
Feuil2 : Chaine2 = col1 & col2 & col3 & col4
Condition : si "chaine1" = "chaine2" je copie "col5" de la feuil2 à la col6 de la "Feuil1".
-----> Le souci est qu'on trouve pour la même chaine i (où i=1, 2) des lignes identiques avec des montant en col5 différents.
---> Pour la même année, les montant sont saisies 1 ou plusieurs mois c'est pourquoi on a les doublons.
L'objectif est que pour la même année c'est de cumuler les montants pour ne garder qu'une lignes "totale" et supprimer les autres doublons.
Je ne sais vraiment pas comment s'y prendre pour gérer ceci en VBA.
Encore merci les experts VBA.
Bonne journée !!
Fichier exemple joint.
Bonjour
Un essai à tester. Te convient-il ?
Option Explicit
Dim tablo1, tablo2, dico As Object
Dim i&
Sub Reporter()
tablo1 = Sheets("Feuil1").Range("A1").CurrentRegion
tablo2 = Sheets("Feuil2").Range("A1").CurrentRegion
Set dico = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo1, 1)
dico(tablo1(i, 1) & tablo1(i, 2) & tablo1(i, 3) & tablo1(i, 4)) = 0
Next i
For i = 2 To UBound(tablo2, 1)
If Not dico.exists(tablo2(i, 1) & tablo2(i, 2) & tablo2(i, 3) & tablo2(i, 4)) Then
dico(tablo2(i, 1) & tablo2(i, 2) & tablo2(i, 3) & tablo2(i, 4)) = 0
Else
dico(tablo2(i, 1) & tablo2(i, 2) & tablo2(i, 3) & tablo2(i, 4)) _
= dico(tablo2(i, 1) & tablo2(i, 2) & tablo2(i, 3) & tablo2(i, 4)) + tablo2(i, 5)
End If
Next i
For i = 2 To UBound(tablo1, 1)
tablo1(i, 6) = dico(tablo1(i, 1) & tablo1(i, 2) & tablo1(i, 3) & tablo1(i, 4))
Next i
Range("A1").Resize(UBound(tablo1, 1), UBound(tablo1, 2)) = tablo1
Range("A1").CurrentRegion.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6), Header:=xlYes
End SubBye !
Bonjour gmb,
Je vous remercie pour votre retour. Par contre je n'ai pas bien compris ce que fait le programme.
Peut-être, je n'ai pas bien expliqué mon besoin.
En résumé, je veux la somme de tous les doublons sur chacune des deux feuilles séparément et ensuite ne garder que la ligne totale et supprimer les autres lignes.
J'ai un programme qui copie la colonne "E" de la Feuil2 vers la Feuil1.
Je vous remercie infiniment.!
Bonjour
En effet, je n'ai pas bien compris.
Et je ne suis toujours pas sûr de bien comprendre. Aussi, il serait bon que tu joignes un exemple du résultat attendu.
Bye !
Bonjour gmb,
Je vous remercie pour votre retour !
J'ai trouvé une solution avec ce code.
Sub CombineRows()
'Updateby Extendoffice
Dim WorkRng As Range
Dim Dic As Variant
Dim arr As Variant
On Error Resume Next
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Set Dic = CreateObject("Scripting.Dictionary")
arr = WorkRng.Value
For i = 1 To UBound(arr, 1)
Dic(arr(i, 1)) = Dic(arr(i, 1)) + arr(i, 2)
Next
Application.ScreenUpdating = False
WorkRng.ClearContents
WorkRng.Range("A1").Resize(Dic.Count, 1) = Application.WorksheetFunction.Transpose(Dic.keys)
WorkRng.Range("B1").Resize(Dic.Count, 1) = Application.WorksheetFunction.Transpose(Dic.items)
Application.ScreenUpdating = True
End Sub
Mais j'ai un autre besoin pour terminer mon sujet (fichier joint avec un exemple de résultat souhaité).
L'objectif est de décomposer le contenu d'une cellule avec un séparateur "|" qui sépare le contenu de la cellule.
Exemple :
05|2021|PIA-CIE|PRESTATIONS EXTERNES|SUBVENTIONS|2017
Il sera décomposé comme suit :
Colonne A (Mois) = 05 ; Colonne B (ANNEE) = 2021; Colonne C (ACTE) = PIA-CIE; Colonne D (TYPE) =PRESTATIONS EXTERNES ; Colonne E (NATURE)=SUBVENTIONS ; Colonne F(ANNEE GESTION) =2017
Bonjour
Un essai à tester. Te convient-il ?
Option Explicit
Dim tablo, tabloR(), fd As Worksheet
Dim i&, k&, n&, nb&
Sub Décomoser()
tablo = Range("A2:B" & Range("A" & Rows.Count).End(xlUp).Row)
ReDim tabloR(1 To UBound(tablo, 1), 1 To 7)
Set fd = Sheets("Destination")
k = 0
For i = 1 To UBound(tablo, 1)
nb = UBound(Split(tablo(i, 1), "|"))
For n = 0 To nb
tabloR(i, n + 1) = Split(tablo(i, 1), "|")(n)
Next n
tabloR(i, 7) = tablo(i, 2)
Next i
fd.Range("A1").CurrentRegion.Offset(1, 0).ClearContents
fd.Range(fd.Columns(1), fd.Columns(7)).Borders.LineStyle = xlNone
fd.Range("A2").Resize(UBound(tablo, 1), 7) = tabloR
fd.Range("A2").Resize(UBound(tablo, 1), 7).Borders.LineStyle = xlContinuous
fd.Activate
End SubBye !
Bonjour gmb,
Je vous remercie pour votre retour, il convient parfaitement bien à demande.
Sans vouloir abuser, j'ai une autre question sur le même fichier.
Est-ce le sens inverse est possible(i.e. partir de la feuille "Destination" pour obtenir la feuille "Source") svp?
Une petite explication :
Je constitue manuellement la feuille "source" à partir de la feuille "destination" à fin d'avoir une "KEY" pour traiter les doublons.
Une fois les doublons traitée, je dois reconstituer la feuille destination à partir de la feuille "source".
Je vous remercie infiniment et vous souhaite excellente journée !
Remarque :
Il y a deux onglets source et deux onglets destination (engagement et versement).
Bonjour
Nouvel essai à tester.
Sub SourceReconstituée()
tablo = Range("A1").CurrentRegion
ReDim tabloR(1 To UBound(tablo, 1) - 1, 1 To 2)
If tablo(2, 1) = "" Then Exit Sub
For i = 2 To UBound(tablo, 1)
tabloR(i - 1, 1) = Format(tablo(i, 1), "00") & "|"
For j = 2 To UBound(tablo, 2) - 2
tabloR(i - 1, 1) = tabloR(i - 1, 1) & tablo(i, j) & "|"
Next j
tabloR(i - 1, 1) = tabloR(i - 1, 1) & tablo(i, UBound(tablo, 2) - 1)
tabloR(i - 1, 2) = tablo(i, UBound(tablo, 2))
Next i
With Sheets("Source recontituée")
.Range("A2").CurrentRegion.Offset(1, 0).ClearContents
.Range("A2").Resize(UBound(tabloR, 1), UBound(tabloR, 2)) = tabloR
.Activate
End With
End SubBye !
Bonjour gmb,
Votre programme fonction parfaitement.
Je vous remercie infiniment !!!!