Combiner entre deux tableaux
Bonjour
Je souhaite combiner deux tableaux (Global et Détail) pour avoir un troisième qui s’appelle résultat.
Avant de commencer voici les colonnes communes entre les deux tableaux
Global (colonne Clé Prim et colonne Date synthèse) .montant débit et crédit est la somme du plusieurs montant Cheque du tableau détail
Détail (colonne Clé Prim et colonne synthèse) .montant Cheque c'est le détail du débit ou crédit du tableau Global
1- tableau Global
2-tableau détail
3- tableau résultat
si le dédit <> 0 then
je doit chercher sont détail dans tableau Detail colonne montant grace a la Clé prim
si existe then
je copier ce detail dans le tableau resultat colonne debit et remplire les autre colonne par l'information de la ligne detail
si non
je garde l'information de la ligne tableau global
end si
else
je doit chercher le détail du montant crédit dans tableau Détail colonne montant cheque grâce a date synthèse
si existe then
je copier ce détail dans le tableau résultat colonne crédit et remplire les autre colonne par l'information de la ligne détail
si non
je garde l'information de la ligne tableau global
end si
end si
voici un exemple qui explique tous les cas
Hello,
Voici une proposition :
J'ai vu que dans le résultat tu ne mettais pas que les numéros de cheque. Notamment lorsque la clé primaire n'est pas trouvée.
Comme tu n'as rien dit j'ai fait comme ci j'avais pas vu
bonjour Mr
je n'ai pas trouver les mots pour vous remercier waw c'est impressionnant c'est magnifique c'est génial.
un travail de deux jour en deux seconde mille merci mille merci
Salut Mr
désolé j'ai fait une erreur dans le tableau Détail et lorsque j'ai corrigé cette erreur le détail du crédit ca marche pas et voici le fichier rectifier
Non, je ne peux pas le gérer. Il faut mettre une clé unique dans le detail pour chaque ligne du 126 et ça fonctionnera.
Merci Mr
Je vais lire votre code ligne par ligne pour mieux comprendre son fonctionnement .
et après je vais modifier le fichier détail de tel sort que le code fonctionne.
Mille merci
Bonjour iliess, Rag02700, le forum,
@Rag02700 : quel code !
@ iliess: j'avais tenté de relever ton challenge, voici une variante (un peu tardive, mais comme j'ai un peu galéré, je poste quand même) qui semble fournir le même résultat (sous réserve)
Dim tablo, tablo2, tabloR(), tabloR2()
Dim i, j, k, k2
Sub MettreAjour()
tablo = Sheets("Detail").ListObjects("tableau2").DataBodyRange
Set sh = Sheets("Global")
tablo2 = sh.ListObjects("tableau1").DataBodyRange
k2 = 0
j = 1
Do While j <= UBound(tablo2, 1)
If Application.WorksheetFunction.CountIf(Sheets("Detail").ListObjects("Tableau2").ListColumns(10).DataBodyRange, tablo2(j, 10)) = 0 Then
ReDim Preserve tabloR2(1 To 11, 1 To k2 + 1)
tabloR2(1, 1 + k2) = tablo2(j, 1) * 1
tabloR2(2, 1 + k2) = tablo2(j, 2)
tabloR2(3, 1 + k2) = tablo2(j, 3)
tabloR2(4, 1 + k2) = tablo2(j, 4)
tabloR2(5, 1 + k2) = tablo2(j, 5)
tabloR2(6, 1 + k2) = tablo2(j, 6)
If tablo2(j, 7) <> 0 Then
tabloR2(7, 1 + k2) = tablo2(j, 7)
Else
tabloR2(7, 1 + k2) = ""
End If
If tablo2(j, 8) <> 0 Then
tabloR2(8, 1 + k2) = tablo2(j, 8)
Else
tabloR2(8, 1 + k2) = ""
End If
tabloR2(9, 1 + k2) = ""
tabloR2(10, 1 + k2) = tablo2(j, 10)
tabloR2(11, 1 + k2) = tablo2(j, 11) * 1
End If
j = j + 1
k2 = k2 + 1
Loop
k = 0
For i = 1 To UBound(tablo, 1)
ReDim Preserve tabloR(1 To 11, 1 To k + 1)
tabloR(1, 1 + k) = WorksheetFunction.Index(sh.ListObjects("Tableau1").ListColumns(1).DataBodyRange, WorksheetFunction.Match(tablo(i, 10), sh.ListObjects("Tableau1").ListColumns(10).DataBodyRange, 0)) * 1
tabloR(2, 1 + k) = WorksheetFunction.Index(sh.ListObjects("Tableau1").ListColumns(2).DataBodyRange, WorksheetFunction.Match(tablo(i, 10), sh.ListObjects("Tableau1").ListColumns(10).DataBodyRange, 0))
tabloR(3, 1 + k) = WorksheetFunction.Index(sh.ListObjects("Tableau1").ListColumns(3).DataBodyRange, WorksheetFunction.Match(tablo(i, 10), sh.ListObjects("Tableau1").ListColumns(10).DataBodyRange, 0))
tabloR(4, 1 + k) = WorksheetFunction.Index(sh.ListObjects("Tableau1").ListColumns(4).DataBodyRange, WorksheetFunction.Match(tablo(i, 10), sh.ListObjects("Tableau1").ListColumns(10).DataBodyRange, 0))
tabloR(5, 1 + k) = WorksheetFunction.Index(sh.ListObjects("Tableau1").ListColumns(5).DataBodyRange, WorksheetFunction.Match(tablo(i, 10), sh.ListObjects("Tableau1").ListColumns(10).DataBodyRange, 0))
tabloR(6, 1 + k) = WorksheetFunction.Index(sh.ListObjects("Tableau1").ListColumns(6).DataBodyRange, WorksheetFunction.Match(tablo(i, 10), sh.ListObjects("Tableau1").ListColumns(10).DataBodyRange, 0))
If WorksheetFunction.Index(sh.ListObjects("Tableau1").ListColumns(7).DataBodyRange, WorksheetFunction.Match(tablo(i, 10), sh.ListObjects("Tableau1").ListColumns(10).DataBodyRange, 0)) <> 0 Then
tabloR(7, 1 + k) = tablo(i, 9)
Else
tabloR(7, 1 + k) = ""
End If
If WorksheetFunction.Index(sh.ListObjects("Tableau1").ListColumns(8).DataBodyRange, WorksheetFunction.Match(tablo(i, 10), sh.ListObjects("Tableau1").ListColumns(10).DataBodyRange, 0)) <> 0 Then
tabloR(8, 1 + k) = tablo(i, 9)
Else
tabloR(8, 1 + k) = ""
End If
tabloR(9, 1 + k) = tablo(i, 5)
tabloR(10, 1 + k) = tablo(i, 10)
tabloR(11, 1 + k) = WorksheetFunction.Index(sh.ListObjects("Tableau1").ListColumns(11).DataBodyRange, WorksheetFunction.Match(tablo(i, 10), sh.ListObjects("Tableau1").ListColumns(10).DataBodyRange, 0)) * 1
k = 1 + k
Next i
With Sheets("Resultat")
On Error Resume Next
.ListObjects("RESULTAT").DataBodyRange.Delete
.Range("A5").Resize(UBound(tabloR, 2), 11) = Application.Transpose(tabloR)
.Range("A" & .Range("A" & Rows.Count).End(xlUp).Row + 1).Resize(UBound(tabloR2, 2), 11) = Application.Transpose(tabloR2)
.Range("RESULTAT[[DEBIT]:[CREDIT]]").NumberFormat = "#,##0.00 $"
.Range("RESULTAT[[DATE]:[DATE SYNT]]").HorizontalAlignment = xlCenter: Range("RESULTAT[[DATE]:[DATE SYNT]]").VerticalAlignment = xlCenter
If Not .Range("RESULTAT[[DATE]]").SpecialCells(xlCellTypeBlanks) Is Nothing Then .Range("RESULTAT[[DATE]]").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
End With
Erase tablo: Erase tablo2: Erase tabloR: Erase tabloR2
End SubCordialement,
merci beaucoup Mr @xorsankukai
oui ca marche très bien et très rapide je vais le tester demain dans ma base de donnée qui contient beaucoup de ligne
Svp comment ajouter cette condition
le code a trouver que la clé existe dans les deux tableau mais le montant dans le tableau global est diffèrent dans le détail alors je doit garder la ligne du tableau global paracerque le détail est faux
02/01/2020 janv ABC 000006 51105 AAA 12,00 0,00 721 721 _ 02/01/2021 02/01/2021 Tableau global
Tableau Detail
34325 02/01/2021 2,00 721 _ 02/01/2021
49833 02/01/2021 4,00 721 _ 02/01/2021
13228 02/01/2021 1,00 721 _ 02/01/2021
48087 02/01/2021 1,00 721 _ 02/01/2021
39947 02/01/2021 1,00 721 _ 02/01/2021
12 <> 9
la clé existe dans les deux tableau mais la somme du détail est différente que le globale alors dans feuil résultat je garde la ligne global car le détail est faux
et Mr @Rag02700 j'ai pense d'ajouter cette ligne dans votre code mais j'ai coincer.
If New_Glob(y).Deb_Glob <> Application.WorksheetFunction.SumIf(New_Detail().Montant, New_Glob(y).Cle_Prim_Glob, New_Detail().Montant) ThenBonsoir Mr @xorsankukai
je vous explique plus
je cherche de rapprocher entre deux tableaux
les montant du débit leur détail est relier par la clé Prim Feuil detail
les montant du crédit leur détail est relier par Date Syn feuil detail
si débit <> 0 then
si sa clé prim existe dans feuil detail et le montant débit = la somme des montant de cette clé then
tableau resultat copier ces montant au débit et complete les autre cellule par les information tableau global
else
garder cette ligne du tableau global dans tableau resultat
fin si
else
si sa date Syn existe dans feuil detail colonne date Syn et le montant credit = la somme des montant de cette date Syn then
tableau résultat copier ces montant au crédit et complète les autre cellule par les information tableau global
else
garder cette ligne du tableau global dans tableau resultat
fin si
fin si
Bonsoir
Merci Mr Rag02700 , Merci Mr xorsankukai
j'ai apris beaucoup de choses grace a vos codes je vous remercier beaucoup
J'ai reconstituer le code et il fonction tres bien et reponds a tous mes questions selement il est long par raport a vos codes.
je suis faible a l'utilisation des tablo
svp qui parmis vous peu modifier ce code avec l'utilisation des tablo pour le faire plus rapide
je vous remercier infiniment
Sub test()
Dim ShHis As Worksheet, ShGtc As Worksheet, ShRes As Worksheet
Dim Plag1 As Range, Plag2 As Range, Plag3 As Range, Plag4 As Range, Plag5 As Range
Dim Q As Long, W As Long, Lign1 As Long, lign2 As Long, lign3 As Long
Dim Masum As Currency, Masum2 As Currency, Masum3 As Currency, Masum4 As Currency
Set ShHis = ThisWorkbook.Worksheets("Hisseb")
Set ShGtc = ThisWorkbook.Worksheets("Gtc")
Set ShRes = ThisWorkbook.Worksheets("Resultat")
Lign1 = ShHis.Cells(ShHis.Rows.Count, 1).End(xlUp).Row
lign2 = ShGtc.Cells(ShGtc.Rows.Count, 1).End(xlUp).Row
lign3 = ShRes.Cells(ShRes.Rows.Count, 1).End(xlUp).Row + 1
Set Plag1 = ShGtc.Range("B4:B" & lign2)
Set Plag2 = ShGtc.Range("I4:I" & lign2)
Set Plag3 = ShGtc.Range("J4:J" & lign2)
With Application
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
For Q = 4 To Lign1
If ShHis.Range("G" & Q).Value <> 0 Then
Masum = Application.WorksheetFunction.SumIf(Plag3, ShHis.Range("J" & Q), Plag2)
If ShHis.Range("G" & Q).Value = Masum Then
For W = 4 To lign2
If ShGtc.Range("J" & W).Value = ShHis.Range("J" & Q).Value Then
ShRes.Range("A" & lign3).Value = ShHis.Range("A" & Q).Value
ShRes.Range("B" & lign3).Value = ShHis.Range("B" & Q).Value
ShRes.Range("C" & lign3).Value = ShHis.Range("C" & Q).Value
ShRes.Range("D" & lign3).Value = ShHis.Range("D" & Q).Value
ShRes.Range("E" & lign3).Value = ShHis.Range("E" & Q).Value
ShRes.Range("F" & lign3).Value = ShHis.Range("F" & Q).Value
ShRes.Range("G" & lign3).Value = ShGtc.Range("I" & W).Value
ShRes.Range("H" & lign3).Value = 0#
ShRes.Range("I" & lign3).Value = ShGtc.Range("E" & W).Value
ShRes.Range("J" & lign3).Value = ShHis.Range("J" & Q).Value
ShRes.Range("K" & lign3).Value = ShHis.Range("K" & Q).Value
lign3 = lign3 + 1
Set Plag4 = ShRes.Range("G4:G" & lign3)
Set Plag5 = ShRes.Range("J4:J" & lign3)
Masum2 = Application.WorksheetFunction.SumIf(Plag5, ShHis.Range("J" & Q), Plag4)
If ShHis.Range("G" & Q).Value = Masum2 Then
GoTo X
End If
End If
Next W
Else
ShRes.Range("A" & lign3).Value = ShHis.Range("A" & Q).Value
ShRes.Range("B" & lign3).Value = ShHis.Range("B" & Q).Value
ShRes.Range("C" & lign3).Value = ShHis.Range("C" & Q).Value
ShRes.Range("D" & lign3).Value = ShHis.Range("D" & Q).Value
ShRes.Range("E" & lign3).Value = ShHis.Range("E" & Q).Value
ShRes.Range("F" & lign3).Value = ShHis.Range("F" & Q).Value
ShRes.Range("G" & lign3).Value = ShHis.Range("G" & Q).Value
ShRes.Range("H" & lign3).Value = 0#
ShRes.Range("K" & lign3).Value = ShHis.Range("K" & Q).Value
lign3 = lign3 + 1
End If
Else
Masum3 = Application.WorksheetFunction.SumIf(Plag1, ShHis.Range("J" & Q), Plag2)
If ShHis.Range("H" & Q).Value = Masum3 Then
For W = 4 To lign2
If ShGtc.Range("B" & W).Value = ShHis.Range("J" & Q).Value Then
ShRes.Range("A" & lign3).Value = ShHis.Range("A" & Q).Value
ShRes.Range("B" & lign3).Value = ShHis.Range("B" & Q).Value
ShRes.Range("C" & lign3).Value = ShHis.Range("C" & Q).Value
ShRes.Range("D" & lign3).Value = ShHis.Range("D" & Q).Value
ShRes.Range("E" & lign3).Value = ShHis.Range("E" & Q).Value
ShRes.Range("F" & lign3).Value = ShHis.Range("F" & Q).Value
ShRes.Range("G" & lign3).Value = 0#
ShRes.Range("H" & lign3).Value = ShGtc.Range("I" & W).Value
ShRes.Range("I" & lign3).Value = ShGtc.Range("E" & W).Value
ShRes.Range("J" & lign3).Value = ShHis.Range("J" & Q).Value
ShRes.Range("K" & lign3).Value = ShHis.Range("K" & Q).Value
lign3 = lign3 + 1
Set Plag4 = ShRes.Range("H4:H" & lign3)
Set Plag5 = ShRes.Range("J4:J" & lign3)
Masum4 = Application.WorksheetFunction.SumIf(Plag5, ShHis.Range("J" & Q), Plag4)
If ShHis.Range("H" & Q).Value = Masum2 Then
GoTo X
End If
End If
Next W
Else
ShRes.Range("A" & lign3).Value = ShHis.Range("A" & Q).Value
ShRes.Range("B" & lign3).Value = ShHis.Range("B" & Q).Value
ShRes.Range("C" & lign3).Value = ShHis.Range("C" & Q).Value
ShRes.Range("D" & lign3).Value = ShHis.Range("D" & Q).Value
ShRes.Range("E" & lign3).Value = ShHis.Range("E" & Q).Value
ShRes.Range("F" & lign3).Value = ShHis.Range("F" & Q).Value
ShRes.Range("G" & lign3).Value = 0#
ShRes.Range("H" & lign3).Value = ShHis.Range("H" & Q).Value
ShRes.Range("K" & lign3).Value = ShHis.Range("K" & Q).Value
lign3 = lign3 + 1
End If
End If
X:
Next Q
With Application
.Calculation = xlCalculationAutomatic
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub