XL 2010 trie de données sur une seconde feuille

[Vanille]

bonjour,

je voudrais faire en automatique un trie de données sur une seconde feuille.

ci joint un fichier de ce que je voudrais

Feuil 1 :feuille de saisie en générale
Feuil 2 : je voudrais trier par nom puis type et couleur les mêmes éléments saisie et faire la somme.

merci pour votre aide

vanille

 

[job75]

Bonjour Vanille,

C'est un problème intéressant mais pas très simple.

Voyez le fichier joint et le code de la feuille "Tri" :

Option Compare Text 'la casse est ignorée

Private Sub Worksheet_Activate()
Dim tablo, resu(), i&, j%, n%
'---tri sur 3 colonnes---
With Feuil1.[A1].CurrentRegion
    .AutoFilter: .AutoFilter 'si le tableau est filtré
    .Columns(5).Insert xlToRight 'insère une colonne auxiliaire
    .Cells(1, 5) = 1: .Columns(5).DataSeries 'numérotation
    .Resize(, 5).Sort .Columns(1), xlAscending, .Columns(3), , xlAscending, .Columns(4), xlAscending, Header:=xlYes
    tablo = .Resize(, 4) 'matrice, plus rapide
    .Resize(, 5).Sort .Columns(5), xlAscending 'ordre initial
    .Columns(5).Delete xlToLeft
End With
'---transposition en sautant la colonne B---
ReDim resu(1 To 4, 1 To UBound(tablo))
For i = 1 To UBound(tablo)
    resu(4, i) = 1 'prénumérotation
    For j = 1 To 3
        resu(j, i) = tablo(i, IIf(j = 1, 1, j + 1))
Next j, i
resu(4, 1) = "Quantité"
'---comptage et repérage des colonnes en doublon---
For i = UBound(tablo) To 2 Step -1
    If resu(1, i) = resu(1, i - 1) And resu(2, i) = resu(2, i - 1) And resu(3, i) = resu(3, i - 1) Then
        resu(4, i - 1) = resu(4, i) + 1 'comptage
        resu(4, i) = "" 'repérage de la colonne en doublon
    End If
Next i
'---suppression des colonnes en doublon---
For i = 1 To UBound(tablo)
    If resu(4, i) <> "" Then
        n = n + 1
        For j = 1 To 4
            resu(j, n) = resu(j, i)
        Next j
    End If
Next i
'---restitution---
With [A1] '1ère cellule, à adapter
    .Resize(4, n) = resu
    .Offset(, n).Resize(4, Columns.Count - n - .Column + 1).Delete xlToLeft 'RAZ à droite
    .Resize(4, n).Borders.Weight = xlThin 'bordures
End With
With UsedRange: End With 'actualise la barre de défilement horizontale
End Sub

La macro se déclenche quand on active la feuille.

L'exécution est très rapide car on utilise des tableaux VBA.

Edit : pour tester j'ai recopié le tableau de la feuille "Base" sur 80 000 lignes => 0,6 seconde chez moi.

A+

 

[job75]

Cela dit je ne vois pas l'intérêt de transposer le tableau car on se limite ainsi à 16384 colonnes.

Perso je préfèrerais utiliser ce fichier (2) sans transposition.

 

[JEV]

Voilà la réponse avec un tableau dynamique feuil3

 

[job75]

Voilà la réponse avec un tableau dynamique feuil3

Le problème consiste à déterminer la fréquence d'apparition des colonnes (Quantité).

Je ne la vois pas dans cette solution.

 

[chris]

Bonjour à tous

Ci-joint 3 solutions :

• un simple TCD
• 2 solution PowerQuery (en add on à partir de 2010, intégré à Excel à partir de 2016)
  • selon la demande initiale
  • similaire à la seconde proposition de job75 avec qui je partage le doute sur le bien fondé de la transposition

 

[job75]

Bonjour chris,

Je suis loin de bien connaître les TCD (et encore moins Power Query).

Comment fais-tu pour créer le champ Quantité dans ton TCD (il n'existe pas dans le tableau source) ?

A+

 

[chris]

RE
@job 75

Chaque champ, calculé notamment (placé en valeurs) peut être nommé comme on veut
Ici j'ai simplement remplacé nombre de nom qui est attribué automatiquement par Quantité

 

[job75]

Merci chris mais je ne comprends toujours pas comment tu arrives à ce TCD.

Si par exemple je supprime la colonne Quantité du TCD comment faire pour la remettre ?

 

[chris]

Re

Si tu affiches les paramètres de ce champ tu vois que sa source est le champ Nom sur lequel a porté l'opération Nombre et que le nom personnalisé est Quantité

Donc il suffit de remettre Nom (ou un autre car le TCD comptant les lignes, cela ne change pas) dans la zone valeurs et d'appliquer les mêmes choix.

Je peux te MP ?

 

[job75]

Bon il faut être un peu au courant des diverses fonctionnalités, j'y suis enfin arrivé, merci.

Je peux te MP ?

Bien sûr, ce sera un plaisir

 

[job75]

Bonjour Vanille, chris, le forum,

Ma solution précédente avec les tris a l'avantage de fonctionner sur PC et sur MAC.

Cette solution utilise le Dictionary et ne fonctionne pas sur MAC :

Private Sub Worksheet_Activate()
Dim d As Object, tablo, i&, x$, a, b, resu(), s, j%
'---comptage---
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
tablo = Feuil1.[A1].CurrentRegion.Resize(, 4) 'matrice, plus rapide
For i = 1 To UBound(tablo)
    x = tablo(i, 1) & Chr(1) & tablo(i, 3) & Chr(1) & tablo(i, 4) 'concaténation
    d(x) = d(x) + 1
Next i
'---tableau des résultats transposé---
a = d.keys: b = d.items
ReDim resu(3, UBound(a)) 'base 0
For i = 0 To UBound(a)
    resu(3, i) = b(i)
    s = Split(a(i), Chr(1))
    For j = 0 To 2
        resu(j, i) = s(j)
Next j, i
resu(3, 0) = "Quantité"
'---restitution---
Application.ScreenUpdating = False
With [A1] '1ère cellule, à adapter
    With .Resize(4, d.Count)
        .Value = resu
        .Cells(1) = " " & .Cells(1)
        .Sort .Rows(1), xlAscending, Orientation:=2 'tri horizontal sur les noms
        .Cells(1) = LTrim(.Cells(1))
        .Borders.Weight = xlThin 'bordures
    End With
    .Offset(, d.Count).Resize(4, Columns.Count - d.Count - .Column + 1).Delete xlToLeft 'RAZ à droite
End With
With UsedRange: End With 'actualise la barre de défilement horizontale
End Sub

Elle est encore plus rapide : 0,20 seconde chez moi sur 80 000 lignes.

Fichiers joints avec et sans transposition.

Bonne journée.