Dictionnaire avec item Tableau

Bonjour;

Ceci concerne le traitement d'une balance comptable

J'ai réussi et grâce à certains d'entres vous et je vous remercie à faire la chose suivante :

J'ai deux feuilles avec des balances N et N-1

J'ai mis sur une troisième intitulé synthèse balance

La liste des compte sans doublon de la feuille 1 et les sommes associés puis à la suite la liste des compte de feuille 2 sur le même principe, puis ma macro tri par ordre croissant.

Sauf que j'ai des comptes commun et je ne sais pas gerer les doublons par dictionnaire avec 2 item par clé. J'ai pensé utiliser un tableau, mais je m'y perd un peu.

Vous trouverez l'avancement de mes travaux sur le fichier joint.

Si qqun peut m'aider c'est sympa !

Bonjour

a tester

Edit : Voir mon prochain message

Bonjour,

sans dictionnaire (qui est plus rapide encore) mais avec index/equiv

P.

Bonjour

Une nouvelle version qui corrige un bug (enfin j'espère ) : Il y a des comptes uniques

Bonsoir à tous,

A tester :

Option Explicit

Sub Balance()
Dim a, i As Long, w
    a = Sheets("balances").Range("a1").CurrentRegion.Value
    With CreateObject("Scripting.Dictionary")
        For i = 2 To UBound(a, 1)
            ReDim w(1 To 3)
            w(1) = a(i, 1): w(2) = a(i, 3)
            .Item(a(i, 1)) = w
        Next
        a = Sheets("Balance N-1").Range("a1").CurrentRegion.Value
        For i = 2 To UBound(a, 1)
            If .exists(a(i, 1)) Then
                w = .Item(a(i, 1))
                w(3) = a(i, 3)
            Else
                ReDim w(1 To 3)
                w(1) = a(i, 1): w(3) = a(i, 3)
            End If
            .Item(a(i, 1)) = w
        Next
        Application.ScreenUpdating = False
        On Error Resume Next
        Application.DisplayAlerts = False
        Sheets("Synthese").Delete
        On Error GoTo 0
        Sheets.Add(after:=Sheets(Sheets.Count)).Name = "Synthese"
        Sheets("Synthese").Cells(1).Resize(1, 3).Value = Array("Compte", "Solde", "Solde N-1")
        Sheets("Synthese").Cells(1).Offset(1).Resize(.Count, 3).Value = _
        Application.Transpose(Application.Transpose(.items))
        With Sheets("Synthese").Cells(1).CurrentRegion
            .Font.Name = "calibri"
            .Font.Size = 10
            .VerticalAlignment = xlCenter
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            With .Rows(1)
                .BorderAround Weight:=xlThin
                .Interior.ColorIndex = 38
            End With
            .Columns.AutoFit
        End With
        Application.ScreenUpdating = True
    End With
End Sub

klin89

Super, Banzai je te remercie ca marche très bien.

Je vais regarder ton code pour le comprendre et apprendre;

Klin, je vais regarder le tien aussi (celui de banzai est vraiment très court en execution et en ligne de code) mais lire du code permet d'apprendre donc merci également pour ton point de vue.

Je reviens vers vous dans la matinée

bonjour, j'arrive après la bataille mais c'est pas grave parce que ma version comportait une erreur !

Re Prypry,

Arf, pas vu que la colonne "Compte" de chacune de tes feuilles comportait des doublons

Donc, j'ai tout faux

klin89

Aucun problème Klin89, merci pour ta participation

Re Prypry,

J'ai rectifié le tir

Je m'appuie sur les 2 feuilles "Balances"

Option Explicit

Sub Balance()
Dim a, i As Long, w()
    a = Sheets("balances").Range("a1").CurrentRegion.Value
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 2 To UBound(a, 1)
            If Not .exists(a(i, 1)) Then
                .Item(a(i, 1)) = VBA.Array(a(i, 1), a(i, 3), Empty)
            Else
                w = .Item(a(i, 1)): w(1) = w(1) + a(i, 3)
                .Item(a(i, 1)) = w
            End If
        Next
        a = Sheets("Balance N-1").Range("a1").CurrentRegion.Value
        For i = 2 To UBound(a, 1)
            If Not .exists(a(i, 1)) Then
                .Item(a(i, 1)) = VBA.Array(a(i, 1), Empty, a(i, 3))
            Else
                w = .Item(a(i, 1)): w(2) = w(2) + a(i, 3)
                .Item(a(i, 1)) = w
            End If
        Next
        a = .items: i = .Count
    End With
    Application.ScreenUpdating = False
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("Synthese").Delete
    On Error GoTo 0
    Sheets.Add(after:=Sheets(Sheets.Count)).Name = "Synthese"
    Sheets("Synthese").Cells(1).Resize(1, 3).Value = Array("Compte", "N", "N-1")
    Sheets("Synthese").Cells(1).Offset(1).Resize(i, 3).Value = Application.Index(a, 0, 0)
    With Sheets("Synthese").Cells(1).CurrentRegion
        .Sort key1:=.Cells(1), order1:=1, Header:=xlYes
        .Font.Name = "calibri"
        .Font.Size = 10
        .VerticalAlignment = xlCenter
        .BorderAround Weight:=xlThin
        .Borders(xlInsideVertical).Weight = xlThin
        With .Rows(1)
            .BorderAround Weight:=xlThin
            .Interior.ColorIndex = 38
        End With
        .Columns.AutoFit
    End With
    Application.ScreenUpdating = True
End Sub

klin89