XL 2013 VBA Grouper valeur

Kidcarotte · 16 Janvier 2020

Bonjour a tous et a toutes

Je souhaiterai mentionne par avance que cela fait deux heures que je tourne en rond sur les forums et que je ne trouve rien de concluant, c'est donc pour cela que je m'adresse ici. J'ai vu le nombre de sujet ouvert, mais les codes proposes ne fonctionne pas et mes connaissances VBA sont tres limites.

J'ai une colonne B de plusieurs noms ( il y en a un peu pres une trentaine et le fichier fais 5000 lignes.)

CK Underwear

TH Accessories

CK Underwear

TH Accessories

CK Jeans

Je voudrais les regrouper par similirate
Donc CK Underwear, TH Accessories etc.
Je sais qu'il y a des formules pour cela, cependant je creer un tableau analytique a partir d une enorme base de donnees.
Donc l'idee est: Lorsque l'utilisateur appuie sur le bouton "Create report" au lieu d'avoir les 1500000 lignes, les 25 grands groupes sont regroupes

Des suggestions ?

Cordialement

danielco · 21 Janvier 2020

Essaie comme ça. J'ai juste rectifié la position du total. Y a-t-il autre chose ?

VB:

Sub TCD()
  Dim C As Range, Plage As Range, Ligne As Long, Col As Long
  With Sheets("Database")
    Set Plage = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
  End With
  With Sheets("Expected (2)")
    Set C = .Cells(1, .Columns.Count).End(xlToLeft).Offset(, 1)
    If C.Column = 2 Then
      C.Value = Date
    Else
      C.Value = DateAdd("ww", 1, Date)
    End If
    C.NumberFormat = "d/mm/yy"
    Col = C.Column
    For Each C In Plage
      Ligne = Application.Match(C.Value, .[A:A], 0)
      .Cells(Ligne, Col) = Cells(Ligne, Col) + 1
    Next C
    Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Cells(Ligne, Col) = Application.Sum(.Range(.Cells(2, Col), .Cells(Ligne - 1, Col)))
  End With
End Sub

Daniel

Kidcarotte · 21 Janvier 2020

Il se pourrait, je suis en train d'essayer de construire un rapport automatique et certaines erreurs apparaissent un peu plus tard. J'ai quelques connaissance VBA mais j'imagine que pas assez sur certain point.

Mais merci beaucoup pour votre aide

Kidcarotte · 21 Janvier 2020

Rebonjour Daniel

Lorsque j'execute le code j'ai une erreur "Type mismatch"
Pour la ligne suivante
Ligne = Application.Match(C.Value, .[A:A], 0)

danielco · 21 Janvier 2020

Ca signifie qu'il y a une division de la feuille Database qui n'existe pas sur la feuille Expected (2). Quand la ligne est surlignée en jaune, passe la souris au-dessus de "C.Value" pour connaître cette valeur. Je peux gérer ce cas de figure, soit en ignorant la valeur et en l'indiquant par un message, soit en ajoutant la valeur sur la feuille Expected (2).

Daniel

Kidcarotte · 21 Janvier 2020

Non je voudrais l'ignorer du coup. Si possible la mettre a 0. Il y a un total maximum mais d'une semaine a l'autre il n y a pas forcement les 24

danielco · 21 Janvier 2020

Je ne peux pas mettre 0 puisqu'elle ne figure pas sur la feuille Expected (2) ? Pour l'ignorer :

VB:

Sub TCD()
  Dim C As Range, Plage As Range, Ligne As Variant, Col As Long
  With Sheets("Database")
    Set Plage = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
  End With
  With Sheets("Expected (2)")
    Set C = .Cells(1, .Columns.Count).End(xlToLeft).Offset(, 1)
    If C.Column = 2 Then
      C.Value = Date
    Else
      C.Value = DateAdd("ww", 1, Date)
    End If
    C.NumberFormat = "d/mm/yy"
    Col = C.Column
    For Each C In Plage
      Ligne = Application.Match(C.Value, .[A:A], 0)
      If IsNumeric(Ligne) Then
        .Cells(Ligne, Col) = Cells(Ligne, Col) + 1
      End If
    Next C
    Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Cells(Ligne, Col) = Application.Sum(.Range(.Cells(2, Col), .Cells(Ligne - 1, Col)))
  End With
End Sub

Daniel

Kidcarotte · 21 Janvier 2020

Merci beaucoup Daniel

J'ai juste une derniere question

Lorsque je fais le total report avec votre Macro, la division "th Outlet arrive a 51"
Or le nombre de transaction = 20

je ne comprends pas comment cela arrive a ce chiffre

Kidcarotte · 21 Janvier 2020

et la semaine d'apres je ne comprends encore moins les valeurs. Etant donne que la base de donnee est la meme, les valeurs devraient etre les meme non ? J'attache le fichier

danielco · 21 Janvier 2020

Désolé il fallait pas l'appeler good macro...

VB:

Sub TCD_Good_Macro()

 Dim C As Range, Plage As Range, Ligne As Variant, Col As Long
 With Sheets("Database")
    Set Plage = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
 End With
With Sheets("Expected (2)")
    Set C = .Cells(1, .Columns.Count).End(xlToLeft).Offset(, 1)
    If C.Column = 2 Then
        C.Value = Date
    Else
        C.Value = DateAdd("ww", 1, Date)
    End If
    C.NumberFormat = "d/mm/yy"
    Col = C.Column
    For Each C In Plage
        Ligne = Application.Match(C.Value, .[A:A], 0)
        If IsNumeric(Ligne) Then
        .Cells(Ligne, Col) = .Cells(Ligne, Col) + 1
        End If
    Next C
    Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Cells(Ligne, Col) = Application.Sum(.Range(.Cells(2, Col), .Cells(Ligne - 1, Col)))
 End With

End Sub

En plus, comme il n'y a plus de ligne total, celui-ci se met sur la ligne "CK Legwear". Je suppose qu'il faut le supprimer ?

Daniel

Kidcarotte · 21 Janvier 2020

Ne vous excusez pas, vous m'avez donne un sacre coup de main deja
Il faut l'ajouter apres, CK Legwear est une autre division

Kidcarotte · 21 Janvier 2020

Je ne suis pas sur egalement de voir la difference entre cette Macro et la version precedente

Cordialement

danielco à dit:
Sub TCD_Good_Macro() Dim C As Range, Plage As Range, Ligne As Variant, Col As Long With Sheets("Database") Set Plage = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)) End With With Sheets("Expected (2)") Set C = .Cells(1, .Columns.Count).End(xlToLeft).Offset(, 1) If C.Column = 2 Then C.Value = Date Else C.Value = DateAdd("ww", 1, Date) End If C.NumberFormat = "d/mm/yy" Col = C.Column For Each C In Plage Ligne = Application.Match(C.Value, .[A:A], 0) If IsNumeric(Ligne) Then .Cells(Ligne, Col) = .Cells(Ligne, Col) + 1 End If Next C Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row .Cells(Ligne, Col) = Application.Sum(.Range(.Cells(2, Col), .Cells(Ligne - 1, Col))) End With End Sub

danielco · 21 Janvier 2020

Si tu ajoutes un libellé sur la feuille Expected (2) pour le total, alors il n'y a rien à changer. Si la cellule A25 reste vide :

VB:

Sub TCD_Good_Macro()

 Dim C As Range, Plage As Range, Ligne As Variant, Col As Long
 With Sheets("Database")
    Set Plage = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
 End With
With Sheets("Expected (2)")
    Set C = .Cells(1, .Columns.Count).End(xlToLeft).Offset(, 1)
    If C.Column = 2 Then
        C.Value = Date
    Else
        C.Value = DateAdd("ww", 1, Date)
    End If
    C.NumberFormat = "d/mm/yy"
    Col = C.Column
    For Each C In Plage
        Ligne = Application.Match(C.Value, .[A:A], 0)
        If IsNumeric(Ligne) Then
        .Cells(Ligne, Col) = .Cells(Ligne, Col) + 1
        End If
    Next C
    Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
    .Cells(Ligne, Col) = Application.Sum(.Range(.Cells(2, Col), .Cells(Ligne - 1, Col)))
 End With

End Sub

Daniel

Kidcarotte · 21 Janvier 2020

Bonjour Daniel

J'ai toujours le probleme ou le "count" n'est pas bon.
Je ne comprends pas comment on obtient 51. Egalement il y a trois CK jeans, et on obtiens 483

danielco · 21 Janvier 2020

Kidcarotte à dit:
Je ne suis pas sur egalement de voir la difference entre cette Macro et la version precedente

Cordialement

Il y a juste un point ajouté après "Cells" :

VB:

.Cells(Ligne, Col) = .Cells(Ligne, Col) + 1

au lieu de :

Code:

.Cells(Ligne, Col) = Cells(Ligne, Col) + 1

Petite cause, grands effets. Sans le point, "Cells" est la cellule de la feuille Database. Avec, elle appartient à la feuille Expected (2) puisque :

Code:

With Sheets("Expected (2)")

indique que tout ce qui commence par un point appartient à la feuille Expected (2)

Daniel

danielco · 21 Janvier 2020

Kidcarotte à dit:
Bonjour Daniel

J'ai toujours le probleme ou le "count" n'est pas bon.
Je ne comprends pas comment on obtient 51. Egalement il y a trois CK jeans, et on obtiens 483

Je ne sais pas d'où tu tiens ces chiffres. Je te joins mon classeur. Mes résultats sont dans la colonne de droite.

Daniel

XL 2013 VBA Grouper valeur

Kidcarotte

XLDnaute Junior

danielco

XLDnaute Accro

Kidcarotte

XLDnaute Junior

Kidcarotte

XLDnaute Junior

danielco

XLDnaute Accro

Kidcarotte

XLDnaute Junior

danielco

XLDnaute Accro

Kidcarotte

XLDnaute Junior

Kidcarotte

XLDnaute Junior

Pièces jointes

danielco

XLDnaute Accro

Kidcarotte

XLDnaute Junior

Kidcarotte

XLDnaute Junior

danielco

XLDnaute Accro

Kidcarotte

XLDnaute Junior

danielco

XLDnaute Accro

danielco

XLDnaute Accro

Pièces jointes

Discussions similaires