XL 2016 [RESOLU] Additionner résultats de deux TCD

Poptar

XLDnaute Nouveau
Bonjour,

J'essaie de trouver une solution pour faciliter le quotidien d'un de mes collègues.
En effet, celui-ci s'occupe de couper des tubes selon des longueurs et RAL différents.
La liste lui est donnée dans un fichier (voir un exemple ci-joint).

Dans le premier onglet, il y a le tableau de base: "Liste des produits" (je l'ai extrêmement simplifié pour l'exemple).
C'est là où toutes les caractéristiques des produits sont entrées.
Le deuxième onglet : "Décompte des tubes" contient deux TCD:
- un pour le décompte des tubes de gauche
- un pour le décompte des tubes de droite

Cependant, pour mon collègue, peu importe si le tube est à gauche ou à droite. C'est la même chose.
Donc il doit identifier si les tubes de gauche et droite sont identiques (même produit, même RAL, même longueur) et si oui : il fait la somme.
Pour l'exemple, c'est assez simple car il y a peu de lignes mais il se peut qu'il y ait plusieurs dizaines de lignes à comparer, donc cela devient vite fastidieux pour lui.

NB1: Pour un produit: le tube de gauche et droite peuvent avoir des longueurs différentes.
NB2: Ces longueurs ne sont pas pré-définies car on fait du sur-mesure.


Donc ma question : existe-t-il un moyen de faire le calcul automatiquement ?
J'ai mis un exemple de résultat que nous aimerions obtenir en bas des tableaux actuels.

Merci beaucoup pour votre temps, ça nous permettra d'être beaucoup plus efficace.

Bonne journée.
 

Pièces jointes

  • Décompte tubes.xlsx
    19.3 KB · Affichages: 14

job75

XLDnaute Barbatruc
Bonjour Poptar, chris,

On peut bien sûr consolider les 2 TCD par VBA :
VB:
Private Sub Worksheet_Activate()
ThisWorkbook.RefreshAll 'commande Actualiser tout
End Sub

Private Sub Worksheet_Calculate()
Dim d As Object, resu(), numpiv%, tablo, i&, x$, n&, lig&
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
ReDim resu(1 To Rows.Count, 1 To 4) '4 colonnes
For numpiv = 1 To 2
    tablo = PivotTables(numpiv).TableRange1 'matrice, plus rapide
    For i = 3 To UBound(tablo)
        x = tablo(i, 1) & Chr(1) & tablo(i, 2) & Chr(1) & tablo(i, 3)
        If x <> Chr(1) & Chr(1) And Not x Like "Total*" Then
            If Not d.exists(x) Then
                n = n + 1
                d(x) = n 'mémorise la ligne
                resu(n, 1) = tablo(i, 1): resu(n, 2) = tablo(i, 2): resu(n, 3) = tablo(i, 3)
            End If
            lig = d(x)
            resu(lig, 4) = resu(lig, 4) + 1 'comptage
        End If
Next i, numpiv
'---restitution---
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
Application.EnableEvents = False 'désactive les évènements
With [A27] '1ère cellule de destination, à adapter
    If n Then
        .Resize(n, 4) = resu
        .Resize(n, 4).Sort .Cells, xlAscending, Header:=xlNo 'tri sur la 1ère colonne
    End If
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 4).ClearContents
End With
With UsedRange: End With 'actualise la barre de défilement verticale
Application.EnableEvents = True 'réactive les évènements
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Worksheet_Calculate 'lance la macro
End Sub
La macro Calculate se déclenche quand on active la feuille ou quand on modifie une cellule quelconque.

Ou encore via la commande Actualiser tout.

A+
 

Pièces jointes

  • Décompte tubes(1).xlsm
    29.5 KB · Affichages: 2

Poptar

XLDnaute Nouveau
Bonjour Poptar, chris,

On peut bien sûr consolider les 2 TCD par VBA :
VB:
Private Sub Worksheet_Activate()
ThisWorkbook.RefreshAll 'commande Actualiser tout
End Sub

Private Sub Worksheet_Calculate()
Dim d As Object, resu(), numpiv%, tablo, i&, x$, n&, lig&
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
ReDim resu(1 To Rows.Count, 1 To 4) '4 colonnes
For numpiv = 1 To 2
    tablo = PivotTables(numpiv).TableRange1 'matrice, plus rapide
    For i = 3 To UBound(tablo)
        x = tablo(i, 1) & Chr(1) & tablo(i, 2) & Chr(1) & tablo(i, 3)
        If x <> Chr(1) & Chr(1) And Not x Like "Total*" Then
            If Not d.exists(x) Then
                n = n + 1
                d(x) = n 'mémorise la ligne
                resu(n, 1) = tablo(i, 1): resu(n, 2) = tablo(i, 2): resu(n, 3) = tablo(i, 3)
            End If
            lig = d(x)
            resu(lig, 4) = resu(lig, 4) + 1 'comptage
        End If
Next i, numpiv
'---restitution---
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
Application.EnableEvents = False 'désactive les évènements
With [A27] '1ère cellule de destination, à adapter
    If n Then
        .Resize(n, 4) = resu
        .Resize(n, 4).Sort .Cells, xlAscending, Header:=xlNo 'tri sur la 1ère colonne
    End If
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 4).ClearContents
End With
With UsedRange: End With 'actualise la barre de défilement verticale
Application.EnableEvents = True 'réactive les évènements
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Worksheet_Calculate 'lance la macro
End Sub
La macro Calculate se déclenche quand on active la feuille ou quand on modifie une cellule quelconque.

Ou encore via la commande Actualiser tout.

A+
Merci job75, c'est vraiment gentil d'avoir pris le temps.
Je ne m'y connais pas en VBA donc je pense pencher pour la solution donnée par chris plus haut.
Encore merci pour ton aide.
 

chris

XLDnaute Barbatruc
Bonjour

J'ai renommé le tableau source ListeProd puis depuis une cellule de ce tableau : Données, A partir d'un tableau, ce qui ouvre PowerQuery
  • sélection des colonnes Ref. du Produit, RAL , clic droit Dépivoter les autres colonnes
    dans la barre de formule remplacer Valeur par Longueur
  • supprimer la colonne Attribut
  • sélection des colonnes Ref. du Produit, RAL et Longueur, Transformer, Regrouper Par, opération Compter le signes, nom Nombre
  • Trier par Ref. du Produit, RAL et Longueur
  • Sortir par Fermer et Charger dans, Table et choisir l'emplacement
 

Poptar

XLDnaute Nouveau
Bonjour

J'ai renommé le tableau source ListeProd puis depuis une cellule de ce tableau : Données, A partir d'un tableau, ce qui ouvre PowerQuery
  • sélection des colonnes Ref. du Produit, RAL , clic droit Dépivoter les autres colonnes
    dans la barre de formule remplacer Valeur par Longueur
  • supprimer la colonne Attribut
  • sélection des colonnes Ref. du Produit, RAL et Longueur, Transformer, Regrouper Par, opération Compter le signes, nom Nombre
  • Trier par Ref. du Produit, RAL et Longueur
  • Sortir par Fermer et Charger dans, Table et choisir l'emplacement
Super, encore un gros merci ça nous est vraiment très utile.
 

Discussions similaires