Addition de 2 tableaux

sofmartel

XLDnaute Nouveau
Sur la feuille J2
le tableau du bas nommé Classement J2 je veut mettre un bouton
Ce bouton doit faire le classement de la Journée J2 c'est à dire qu'il doit prendre en compte les valeurs de la journée d'avant (feuille J1).
Lorsque je clique je veut que le tableau prend en compte les valeur du tableau J1 additionnée au nouvelle valeurs de la journée J2 (tableau nommé Classement sur la feuille J2)
 

sofmartel

XLDnaute Nouveau
Bonjour,
Merci de m'aider sur ce point.
Sur la feuille J2
le tableau du bas nommé Classement J2 je veut mettre un bouton
Ce bouton doit faire le classement de la Journée J2 c'est à dire qu'il doit prendre en compte les valeurs de la journée d'avant (feuille J1).
Lorsque je clique je veut que le tableau prend en compte les valeur du tableau J1 additionnée au nouvelle valeurs de la journée J2 (tableau nommé Classement sur la feuille J2)
Bonne journée
 

Paf

XLDnaute Barbatruc
Re,

une solution possible:
Code:
Private Sub CommandButton1_Click()
Dim Dico1, Dico2, Dico3, Dico4, Dico5, Dico6, Dico7, Dico8, i As Integer, Tablo1, Tablo2

Tablo1 = Worksheets("J1").Range("A41:I52")
Tablo2 = Worksheets("J2").Range("A26:I37")

Set Dico1 = CreateObject("Scripting.Dictionary")
Set Dico2 = CreateObject("Scripting.Dictionary")
Set Dico3 = CreateObject("Scripting.Dictionary")
Set Dico4 = CreateObject("Scripting.Dictionary")
Set Dico5 = CreateObject("Scripting.Dictionary")
Set Dico6 = CreateObject("Scripting.Dictionary")
Set Dico7 = CreateObject("Scripting.Dictionary")
Set Dico8 = CreateObject("Scripting.Dictionary")

For i = LBound(Tablo1, 1) To UBound(Tablo1, 1)
    Dico1(Tablo1(i, 1)) = Tablo1(i, 2)
    Dico2(Tablo1(i, 1)) = Tablo1(i, 3)
    Dico3(Tablo1(i, 1)) = Tablo1(i, 4)
    Dico4(Tablo1(i, 1)) = Tablo1(i, 5)
    Dico5(Tablo1(i, 1)) = Tablo1(i, 6)
    Dico6(Tablo1(i, 1)) = Tablo1(i, 7)
    Dico7(Tablo1(i, 1)) = Tablo1(i, 8)
    Dico8(Tablo1(i, 1)) = Tablo1(i, 9)
Next

For i = LBound(Tablo2, 1) To UBound(Tablo2, 1)
    If Not Dico8.exists(Tablo2(i, 1)) Then MsgBox Tablo2(i, 1)
    Tablo2(i, 2) = Tablo2(i, 2) + Dico1(Tablo2(i, 1))
    Tablo2(i, 3) = Tablo2(i, 3) + Dico2(Tablo2(i, 1))
    Tablo2(i, 4) = Tablo2(i, 4) + Dico3(Tablo2(i, 1))
    Tablo2(i, 5) = Tablo2(i, 5) + Dico4(Tablo2(i, 1))
    Tablo2(i, 6) = Tablo2(i, 6) + Dico5(Tablo2(i, 1))
    Tablo2(i, 7) = Tablo2(i, 7) + Dico6(Tablo2(i, 1))
    Tablo2(i, 8) = Tablo2(i, 8) + Dico7(Tablo2(i, 1))
    Tablo2(i, 9) = Tablo2(i, 9) + Dico8(Tablo2(i, 1))
Next
Worksheets("J2").Range("A41").Resize(UBound(Tablo2, 1), UBound(Tablo2, 2)) = Tablo2
Worksheets("J2").Range("A41:I52").Sort Key1:=Range("B41"), Order1:=xlDescending
End Sub

A+
 

Paf

XLDnaute Barbatruc
re,

En cours d'exécution, un message (ou plusieurs) portant le nom d'une équipe peut s'afficher. Cela indiquerait que dans les deux tableaux, le nom d'une équipe n'est pas orthographié de la même manière ou qu'une équipe est manquante. Il faut impérativement que les noms d'équipes soient identiques (orthographe et casse).


Mais peut-être les propositions sont plus intéressantes sur cet autre site :
http://forum.excel-pratique.com/excel/addition-de-2-tableaux-t83347.html

A+
 

sofmartel

XLDnaute Nouveau
Bonjour,
Ok super j'ai réussi à adapter comme je voulais.
Juste une dernire chose je souhaite incrémenter le nom de ma feuille
=> Ici je récupre le nom de ma feuille active (ici par exemple J3)
Je souhaite que la nouvelle feuille prenne le nom J+1 donc J4 sous forme d'incrémentation
Merci

Dim feuille_courante As String
feuille_courante = ActiveWorkbook.ActiveSheet.Name
MsgBox (feuille_courante)
ActiveSheet.Copy After:=Sheets(Sheets.Count)
 

klin89

XLDnaute Accro
Bonsoir à tous, :)

une autre version :
VB:
Option Explicit
Sub test()
Dim a(), i As Byte, j As Byte, w()
    a = Sheets("J1").[a39].CurrentRegion.Value
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 2 To UBound(a, 1)
            ReDim w(1 To 9)
            For j = 1 To UBound(a, 2)
                w(j) = a(i, j)
            Next
            .Item(a(i, 1)) = w
        Next
        a = Sheets("J2").[a24].CurrentRegion.Value
        For i = 3 To UBound(a, 1)
            w = .Item(a(i, 1))
            For j = 2 To UBound(a, 2)
                w(j) = w(j) + a(i, j)
            Next
            .Item(a(i, 1)) = w
        Next
        a = Application.Index(.items, 0, 0)
    End With
    'Restitution
    With Sheets(3).[a1]
        .Value = "Classement général"
        With .Offset(1).Resize(UBound(a, 1), UBound(a, 2))
            .Value = a
            .Sort Key1:=.Cells(2, 2), Order1:=xlDescending
        End With
    End With
End Sub
klin89
 

Discussions similaires

Réponses
7
Affichages
327
Réponses
10
Affichages
236
  • Résolu(e)
Microsoft 365 Tri et Import
Réponses
4
Affichages
175

Statistiques des forums

Discussions
312 219
Messages
2 086 372
Membres
103 198
dernier inscrit
CACCIATORE