XL 2013 VBA Grouper valeur

[Kidcarotte]

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

CK Underwear

CK Underwear

TH Accessories

CK Underwear

CK Underwear

CK Underwear

CK Underwear

CK Underwear

CK Underwear

CK Underwear

TH Accessories

TH Accessories

TH Accessories

TH Accessories

TH Accessories

TH Accessories

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]

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

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]

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]

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]

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]

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]

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

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]

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]

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]

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

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]

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]

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

Cordialement

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]

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 :

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]

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]

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" :

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

au lieu de :

.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 :

With Sheets("Expected (2)")

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

Daniel

 

[danielco]

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