Discussion :

[seblap47]

Bonjour

J'ai une feuille excel qui ressemble à ça avec au moins 500 lignes.




Comment à l'aide d'une macro obtenir ça dans une autre feuille ?




Merci

[Philippe Tulliez]

Bonjour,
Consolidation par categorie
voir cette reponse http://www.developpez.net/forums/d13...l/#post8172118

[seblap47]

Bonsoir,

Merci pour votre réponse mais même en regardant l'exemple j'ai du mal...

Cordialement

Sébastien

[Philippe Tulliez]

Bonjour,
Ou désolé, je n'avais pas vu que la référence n'était pas en colonne 1 et même dans ce cas là, il faut faire au préalable une concaténation des données alphanumériques et placer les quantités en dernière colonne avant de faire la consolidation.
Ce soir, plus le temps de faire un code.

[boisgontierjacques]

Bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Sub SousTotal()
  a = Range("A2:D" & [a65000].End(xlUp).Row)
  Dim b(): ReDim b(1 To UBound(a), 1 To UBound(a, 2))
  i = 1: j = 0
  Do While i <= UBound(a)
    j = j + 1: b(j, 2) = a(i, 2): b(j, 3) = a(i, 3): b(j, 4) = a(i, 4)
    Do While a(i, 2) = b(j, 2)
      b(j, 1) = b(j, 1) + a(i, 1)
      i = i + 1: If i > UBound(a) Then Exit Do
    Loop
  Loop
 [K2].Resize(UBound(b), UBound(b, 2)) = b
End Sub

Jacques Boisgontier

[seblap47]

Bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Sub SousTotal()
  a = Range("A2:D" & [a65000].End(xlUp).Row)
  Dim b(): ReDim b(1 To UBound(a), 1 To UBound(a, 2))
  i = 1: j = 0
  Do While i <= UBound(a)
    j = j + 1: b(j, 2) = a(i, 2): b(j, 3) = a(i, 3): b(j, 4) = a(i, 4)
    Do While a(i, 2) = b(j, 2)
      b(j, 1) = b(j, 1) + a(i, 1)
      i = i + 1: If i > UBound(a) Then Exit Do
    Loop
  Loop
 [K2].Resize(UBound(b), UBound(b, 2)) = b
End Sub

Jacques Boisgontier

Bonsoir,

Il marche super bien ce code !!!

Merci

[Philippe Tulliez]

Bonjour,
Je me réfère donc à l'illustration du premier fil de la discussion.
La feuille source est sur la feuille nommé [Source] et le résultat sera sur la feuille nommée [Conso]
La méthode préconisée comme solution est la consolidation par catégorie.
Pour obtenir la somme des quantités en les regroupant on doit avoir une colonne avec le texte et les nombres en deuxième colonne or nous avons dans la plage source, les quantités en colonne 1 et trois colonnes avec du texte.
Nous allons donc utiliser une astuce qui consistera en étapes
1) Insérer une colonne devant la première en concaténant les valeurs des trois colonnes contenant du texte.
2) Effectuer la consolidation
3) Reconstruire les données ainsi consolidées en ayant à nouveau les quantités en colonne 1 et les trois colonnes avec les textes.
Finalement traduire en VBA ce que l'on ferait manuellement avec les outils à notre disposition dans Excel. Soit La concaténation des cellules avec '&', l'utilisation de l'outil de consolidation et la commande Convertir.
Procédure

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Sub ConsolidatDataByCategoryAndConcatenate()
 ' *** Déclaration et attribution des variables
 Dim rngConso As Range, rng_1 As Range, rng_2 As Range
 With ThisWorkbook
  Set rngConso = .Worksheets("Conso").Range("A1")
  Set rng_1 = .Worksheets("Source").Range("A1").CurrentRegion
 End With
 ' *** Concaténation sur colonne 1 des cellules des colonnes B, C, D
 rng_1.Columns(1).Insert Shift:=xlToRight ' Insère une colonne
 ' Assignation nouvelle plage (après insertion)
 Set rng_1 = rng_1.Worksheet.Range("A1").CurrentRegion.Resize(columnsize:=2)
 ' Concaténation des colonnes C, D et E
 rng_1.Columns(1).Formula = "=C1 & ""-"" & D1 & ""-"" & E1"
 ' *** Consolidation des données
 With rngConso
 .Worksheet.Cells.Clear ' Supprime les cellules de la feuille
 .Consolidate Sources:=rng_1.Address(ReferenceStyle:=xlR1C1, external:=True), _
              Function:=xlSum, TopRow:=True, LeftColumn:=True
 .Value = rng_1.Cells(1, 1)
 End With
 ' *** Reconstruction des données consolidées
 ' Attribution nouvelle plage
 With rngConso: Set rngConso = .CurrentRegion: End With
 ' Copie la première colonne de la plage consolidée à la fin de celle-ci
 With rngConso
 .Columns(1).Copy .Offset(columnOffset:=2).Resize(columnsize:=1)
  With .Offset(columnOffset:=2).Resize(columnsize:=1)
  .TextToColumns DataType:=xlDelimited, OtherChar:="-"
  End With
 .Columns(1).Delete ' Efface la 1ère colonne de la plage consolidée
 End With
 rng_1.Columns(1).Delete ' Supprime la colonne concaténée de la feuille 1
End Sub