Combinaison de 2 base de données comparatives
Bonjour,
Voici ce que je veux faire.
J'ai 2 base de données de que je veux combiner. J'ai une nouvelle base de données a chaque année mais le problème est que je dois avoir un comparatif sur 2ans avec mes anciens et nouveau chiffres de chacun des comtes. S'il y a de nouveau comptes je dois les ajouter a mon ancienne base de donnée en insérant des lignes. Le problème est que je ne peux pas le faire manuellement car j'ai des base de données avec plus de 1 000 comptes. Je cherche une(des) formule(s) ou macro(s) qui me permettrait de combiner ma base de données 2014 et 2015 comme dans mon exemple. De plus il serait intéressant que si la description relier au numéro de compte change en par celle la plus récente.
ps: Voir document excel pour mon exemple
merci d'avance pour votre aide en espérant avoir été assez claire
Bonjour et bienvenue sur le forum
Un essai à tester. Te convient-il ?
Bye !
Wow ça fonctionne vraiment bien avec mon fichier que tu m'a renvoyé merci beaucoup je vais l'essayé avec mes autres fichiers et je te redonne des nouvelle.
Merci beaucoup pour la rapidité de ta réponse
Bonsoir gmb, jippii101, le forum
Une autre façon de procéder.
En s'appuyant sur les 2 tableaux figurant en Feuil1.
Restitution en Feuil2.
Option Explicit
Sub Alignement()
Dim a, i As Long, j As Long, w, x, y
With Sheets("Feuil1").Range("F1").CurrentRegion
a = .Value
End With
With CreateObject("Scripting.Dictionary")
.CompareMode = 1
For i = 3 To UBound(a, 1)
If IsNumeric(a(i, 1)) Then
ReDim w(1 To UBound(a, 2) * 2 - 2)
For j = 1 To 2
w(j) = a(i, j)
Next
For j = 3 To 4
w(j) = 0
Next
For j = 5 To 6
w(j) = a(i, j - 2)
Next
.Item(a(i, 1)) = w
End If
Next
With Sheets("Feuil1").Range("a1").CurrentRegion
a = .Value
End With
For i = 3 To UBound(a, 1)
If IsNumeric(a(i, 1)) Then
If .exists(a(i, 1)) Then
w = .Item(a(i, 1))
For j = 3 To 4
w(j) = a(i, j)
Next
Else
ReDim w(1 To UBound(a, 2) * 2 - 2)
For j = 1 To UBound(a, 2)
w(j) = a(i, j)
Next
For j = 5 To 6
w(j) = 0
Next
End If
.Item(a(i, 1)) = w
End If
Next
x = .Count: y = .items
Application.ScreenUpdating = False
With Sheets("Feuil2").Cells(1)
.CurrentRegion.Clear
Sheets("Feuil1").Range("A2:D2, H2:I2").Copy .Range("A2").Resize(1, 6)
With .Offset(2).Resize(x, UBound(a, 2) * 2 - 2)
.Value = Application.Transpose(Application.Transpose(y))
With .CurrentRegion
.Sort key1:=.Cells(1), order1:=1, Header:=1
.Font.Name = "calibri"
.Font.Size = 10
.VerticalAlignment = xlCenter
.Borders(xlInsideVertical).Weight = xlThin
.BorderAround Weight:=xlThin
With .Columns(3).Offset(1).Resize(.Rows.Count - 1, 4)
.NumberFormat = "_ * #,##0.00_ ;_ * -#,##0.00_ ;_ * ""-""?? _ ;_ @_ "
.HorizontalAlignment = xlRight
End With
With .Rows(1)
.HorizontalAlignment = xlCenter
.Interior.ColorIndex = 38
.BorderAround Weight:=xlThin
End With
.Columns.AutoFit
End With
End With
End With
End With
Application.ScreenUpdating = True
End Subklin89
Klin89 a écrit :Bonsoir gmb, jippii101, le forum
Une autre façon de procéder.
En s'appuyant sur les 2 tableaux figurant en Feuil1.
Restitution en Feuil2.
Option Explicit Sub Alignement() Dim a, i As Long, j As Long, w, x, y With Sheets("Feuil1").Range("F1").CurrentRegion a = .Value End With With CreateObject("Scripting.Dictionary") .CompareMode = 1 For i = 3 To UBound(a, 1) If IsNumeric(a(i, 1)) Then ReDim w(1 To UBound(a, 2) * 2 - 2) For j = 1 To 2 w(j) = a(i, j) Next For j = 3 To 4 w(j) = 0 Next For j = 5 To 6 w(j) = a(i, j - 2) Next .Item(a(i, 1)) = w End If Next With Sheets("Feuil1").Range("a1").CurrentRegion a = .Value End With For i = 3 To UBound(a, 1) If IsNumeric(a(i, 1)) Then If .exists(a(i, 1)) Then w = .Item(a(i, 1)) For j = 3 To 4 w(j) = a(i, j) Next Else ReDim w(1 To UBound(a, 2) * 2 - 2) For j = 1 To UBound(a, 2) w(j) = a(i, j) Next For j = 5 To 6 w(j) = 0 Next End If .Item(a(i, 1)) = w End If Next x = .Count: y = .items Application.ScreenUpdating = False With Sheets("Feuil2").Cells(1) .CurrentRegion.Clear Sheets("Feuil1").Range("A2:D2, H2:I2").Copy .Range("A2").Resize(1, 6) With .Offset(2).Resize(x, UBound(a, 2) * 2 - 2) .Value = Application.Transpose(Application.Transpose(y)) With .CurrentRegion .Sort key1:=.Cells(1), order1:=1, Header:=1 .Font.Name = "calibri" .Font.Size = 10 .VerticalAlignment = xlCenter .Borders(xlInsideVertical).Weight = xlThin .BorderAround Weight:=xlThin With .Columns(3).Offset(1).Resize(.Rows.Count - 1, 4) .NumberFormat = "_ * #,##0.00_ ;_ * -#,##0.00_ ;_ * ""-""?? _ ;_ @_ " .HorizontalAlignment = xlRight End With With .Rows(1) .HorizontalAlignment = xlCenter .Interior.ColorIndex = 38 .BorderAround Weight:=xlThin End With .Columns.AutoFit End With End With End With End With Application.ScreenUpdating = True End Subklin89
Merci pour la formule je n'ai malheureusement pas été capable de l'utilisé je connais très bien excel et les formules mais je suis assez nouveau avec les macros. J'ai essayé de l'insérer dans excel mais j'ai obtenu un message d'erreur lors de son utilisation. Je vais devoir apprendre a copier des macros dans excel.
gmb a écrit :Bonjour et bienvenue sur le forum
Un essai à tester. Te convient-il ?
Bye !
merci j'ai utilisé ta macro toute la journée j'ai eu quelque petite problème de manipulation des données au départ, mais la macro finissait toujours par fonctionner même avec plus de 1000 comptes merci beaucoup.
J'ai pensé qu'il serait utile pour moi de rajouter une colonne (code) dans mon année précédente et qu'elle suive mes chiffres dans le tableau combiné comme dans mon exemple modifié. Je te remercie encore pour ton fichier je ne suis pas en mesure d'effectuer ses changement moi même pour le moment, mais j'aimerais bien finir par comprendre les macros je trouve cela très utile. Tu as déja fait beaucoup pour moi si tu a le temps et que ce n'est pas très compliquer pour toi de rajouter cette option ça serait apprécier sinon c'Est pas grave.
merci
Wow un gros merci le fichier me semble impeccable !!!!