Autres Code DICO (SD) fonctionne sur 1 wks mais comment l'utiliser sur plusieurs wks ?

zebanx

XLDnaute Accro
Bonjour à tous

J'utilise en Scripting Dictionary ce (super) code très utile de Laetitia90/Job75 (;) ) qui fonctionne parfaitement sur une seule feuille de données.
Mais comment faudrait-il SVP le modifier à nouveau pour que le dictionnaire s'incrémente sur plusieurs feuilles sans avoir besoin de compiler sur une feuille tampon les données ?
Merci pour vos remarques et vos suggestions à venir.

VB:
Sub code_SD_1feuilledetravail()
' code transmis par laetitia90 (+ Job75)
Dim t(), i As Long, m As Object, C As Byte, z
Set m = CreateObject("Scripting.Dictionary")
'--constitution
Sheets("FEUILLE1").Select
t = Range("a2:f" & Cells(Rows.Count, 1).End(3).Row).Value2
For i = 1 To UBound(t)
    z = t(i, 1) & t(i, 2)
    If m.Exists(z) Then
        For C = 5 To 6:  t(m(z), C - 2) = t(m(z), C - 2) + t(i, C): Next C
        t(m(z), 5) = t(m(z), 5) + 1
    Else
        x = x + 1
        For C = 1 To 2: t(x, C) = t(i, C): Next C
        For C = 5 To 6: t(x, C - 2) = t(i, C): Next C
        m(z) = x
        t(x, 5) = 1
    End If
  Next i
'--restitution
Sheets(1).[A2].Resize(x, 5) = t
End Sub

Xl-ment
zebanx
 

Pièces jointes

  • Question_SD_plusieurs feuilles.xlsm
    28.6 KB · Affichages: 14

job75

XLDnaute Barbatruc
Bonsoir zebanx, Pierre :)

Le code de Laetitia complété :
VB:
Sub code_SD_1feuilledetravail()
' code transmis par laetitia90 (+ Job75)
Dim m As Object, resu(), w, t, i As Long, C As Byte, z As String, x As Long
Set m = CreateObject("Scripting.Dictionary")
ReDim resu(1 To Rows.Count, 1 To 5)
'--constitution
For Each w In Sheets(Array("FEUILLE1", "FEUILLE2", "FEUILLE3"))
    t = w.Range("a2:f" & w.Cells(w.Rows.Count, 1).End(3).Row).Value2
    For i = 1 To UBound(t)
        z = t(i, 1) & t(i, 2)
        If m.Exists(z) Then
            For C = 5 To 6:  resu(m(z), C - 2) = resu(m(z), C - 2) + t(i, C): Next C
            resu(m(z), 5) = resu(m(z), 5) + 1
        Else
            x = x + 1
            For C = 1 To 2: resu(x, C) = t(i, C): Next C
            For C = 5 To 6: resu(x, C - 2) = t(i, C): Next C
            m(z) = x
            resu(x, 5) = 1
        End If
Next i, w
'--restitution
Sheets(1).[A2].Resize(x, 5) = resu
End Sub
Il suffisait de mettre les résultats dans un autre tableau (resu).

A+
 

Pièces jointes

  • Question_SD_plusieurs feuilles(1).xlsm
    32.8 KB · Affichages: 4

zebanx

XLDnaute Accro
Bonjour job75 :)

Avec du retard, merci beaucoup d'avoir repris ce code pour le compléter.:)
Les deux méthodes sont très bien (je suis plus à l'aise par habitude avec ce code-là) et je suis une nouvelle fois content d'avoir ce comparatif d'excellente facture. Et si vite de surcroit.

Bonne soirée à toi et à l'ami Pierre-Jean.
Au plaisir de vous lire.
zebanx
 

Discussions similaires

Réponses
14
Affichages
622

Statistiques des forums

Discussions
311 737
Messages
2 082 036
Membres
101 878
dernier inscrit
1475214