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

Kidcarotte · 21 Janvier 2020

Effectivement, merci Daniel encore une fois. La solution etait le point

Merci beaucoup

Kidcarotte · 22 Janvier 2020

Hello Daniel

Je sais pas si vous avez la reponse a ca egalement. Au lieu de la feuille Database comme on avait en feuille 1, je voudrais prendre la database qui se trouve dans un autre classeur excel. Le chemin est le suivant

Dim Chemin As String, Fichier As String
Chemin = "H:\Central Sourcing & production\Divisional Check\Div. Checks"
Fichier = "Divisional Checks - Refresh Data.xlsx"
With Sheets("MISSING PRIO")

Et j'aimerais selectionnee uniquement un nombre specifique de colonne comme donnee. Exemple colonne A, D, J

Auriez vous une formulation VBA ?

danielco · 22 Janvier 2020

Bonjour,

Avec des divisions en colonne A :

VB:

Sub TCD_Good_Macro()

  Dim C As Range, Plage As Range, Ligne As Variant, Col As Long
  Dim Wbk As Workbook, Sh As Worksheet
  Set Wbk = Workbooks.Open("H:\Central Sourcing & production\Divisional Check\Div. Checks\" & _
    "Divisional Checks - Refresh Data.xlsx")
  Set Sh = Sheets("MISSING PRIO")
  With Sh
    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
  Wbk.Close False
End Sub

S'il y a des divisions en colonnes D ou J aussi, dis-le.

Daniel

Kidcarotte · 22 Janvier 2020

Bonjour Daniel

Non il n'y a pas de division en colonne D ou J, mais il y a le PO en colonne J

Donc je suis interessee par le contenue de la colonne A et J

Kidcarotte · 22 Janvier 2020

Egalement vu que Worksheet a ete defini comme Sh, cela change le code pour le reste, J'ai donc changer comme ceci mais cela ne marche pas non plus

Sub TCD_Good_Macro()
Dim C As Range, Plage As Range, Ligne As Variant, Col As Long
Dim Wbk As Workbook, Sh As Worksheet
Set Wbk = Workbooks.Open("H:\Central Sourcing & production\Divisional Check\Div. Checks\" & _
"Divisional Checks - Refreshed Data.xlsx")
Set Sh = Sheets("MISSING PRIO")
With Sh
Set Plage = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
End With
Set Sh = Sheets("Expected (2)")
With Sh
Set C = .Cells(1, .Columns.Count).End(xlToLeft).Offset(, 1)
If C.Column = 5 Then
[...]

danielco · 22 Janvier 2020

Kidcarotte à dit:
Bonjour Daniel

Non il n'y a pas de division en colonne D ou J, mais il y a le PO en colonne J

Donc je suis interessee par le contenue de la colonne A et J

Oui, mais je ne m'occupe pas du PO, ou je me trompe ?

Daniel

danielco · 22 Janvier 2020

Kidcarotte à dit:
Egalement vu que Worksheet a ete defini comme Sh, cela change le code pour le reste, J'ai donc changer comme ceci mais cela ne marche pas non plus

Sub TCD_Good_Macro()
Dim C As Range, Plage As Range, Ligne As Variant, Col As Long
Dim Wbk As Workbook, Sh As Worksheet
Set Wbk = Workbooks.Open("H:\Central Sourcing & production\Divisional Check\Div. Checks\" & _
"Divisional Checks - Refreshed Data.xlsx")
Set Sh = Sheets("MISSING PRIO")
With Sh
Set Plage = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
End With
Set Sh = Sheets("Expected (2)")
With Sh
Set C = .Cells(1, .Columns.Count).End(xlToLeft).Offset(, 1)
If C.Column = 5 Then
[...]

Qu'est-ce quiu ne marche pas ? Une erreur ? Si oui, laquelle ?

Daniel

Kidcarotte · 22 Janvier 2020

L'ouverture du fichier marche super ! Mais apres l erreur suivante apparait Run time error 9, Subscript out of range, et cette erreur est surligne "With Sheets("Expected (2)")"

danielco · 22 Janvier 2020

C'est parce que la feuille résultat ne s'appelle plus Expected (2).

Daniel

Kidcarotte · 22 Janvier 2020

Ben si toujours .... C'est toujours la meme finalite. C'est juste que au lieu de prendre la database en sheet 1 du meme fichier excel, on l'a prend d'un autre dossier excel

danielco · 22 Janvier 2020

Effectivement, autant pour moi.

VB:

With Sheets("Expected (2)")

se réfère au classeur actif. Et le classeur actif est le classeur qu'on vient d'ouvrir.

Code:

Sub TCD_Good_Macro()

  Dim C As Range, Plage As Range, Ligne As Variant, Col As Long
  Dim Wbk As Workbook, Sh As Worksheet
  Set Wbk = Workbooks.Open("H:\Central Sourcing & production\Divisional Check\Div. Checks\" & _
    "Divisional Checks - Refresh Data.xlsx")
  Set Sh = Sheets("MISSING PRIO")
  With Sh
    Set Plage = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp))
  End With
  With ThisWorkbook.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
  Wbk.Close False
End Sub

Kidcarotte · 22 Janvier 2020

Super merci beaucoup !

Maintenant je crois que j'ai une ultime question, car je touche la fin.

Dans le worksheet
"H:\Central Sourcing & production\Divisional Check\Div. Checks\" & _
"Divisional Checks - Refreshed Data.xlsx")

La colonne A et J m'interesse (seulement)

danielco · 22 Janvier 2020

Je ne comprends pas ce que je dois faire avec la colonne J ?

Daniel

Kidcarotte · 28 Janvier 2020

Hello Daniel

Desolee pour le temps de reponse, je pense que jai reussi a resoudre le probleme

Merci par avance

XL 2013 VBA Grouper valeur

Kidcarotte

XLDnaute Junior

Kidcarotte

XLDnaute Junior

Kidcarotte

XLDnaute Junior

danielco

XLDnaute Accro

Kidcarotte

XLDnaute Junior

Kidcarotte

XLDnaute Junior

danielco

XLDnaute Accro

danielco

XLDnaute Accro

Kidcarotte

XLDnaute Junior

danielco

XLDnaute Accro

Kidcarotte

XLDnaute Junior

Pièces jointes

danielco

XLDnaute Accro

Kidcarotte

XLDnaute Junior

danielco

XLDnaute Accro

Kidcarotte

XLDnaute Junior

Discussions similaires