Votre question

VBA ranger par occurences

Tags :
  • Microsoft Excel
  • Programmation
Dernière réponse : dans Programmation
26 Décembre 2016 14:40:08

Bonjour,
j'essaie depuis plusieurs jours de faire une macro mais je n'y arrive pas :??: 

J'ai une colonne dans laquelle apparaît une liste après avoir lancé une macro.
Le truc, c'est que cette liste s’entend sur beaucoup de lignes et je voudrait (comme le ferai un tableau croisé dynamique) afficher un résultat du type 3 références A, 2 références B etc.
Pour avoir un truc lisible facilement.
Si quelqu'un me me donner une piste .....
Merci !

Autres pages sur : vba ranger occurences

a b L Programmation
26 Décembre 2016 15:20:30

C'est ta sortie qui est à trier. Nativement, la donnée apparaît donc en résultat "transparent", ce qui sous-entend qu'il n'y a pas de tri direct. tu devras chercher du côté des fonctions de tris afin de procéder au rangement après exécution du résultat.
m
0
l
26 Décembre 2016 15:26:00

et tu as une idée de comment faire ?
m
0
l
Contenus similaires
a b L Programmation
26 Décembre 2016 15:57:03

Mickoik a dit :
et tu as une idée de comment faire ?


  1. Sub Tri_Article()
  2. 'Macro Dan pour zyglur
  3. Dim plage As Range
  4. Set plage = ActiveSheet.Range("A3:D" & Range("A" & Rows.Count).End(xlUp).Row)
  5. plage.Sort Key1:=Range("A4"), Order1:=xlAscending, Header:=xlGuess, _
  6. OrderCustom:=1, Orientation:=xlTopToBottom
  7. End Sub
m
0
l
26 Décembre 2016 16:03:11

Merci mais cette macro ne me sert qu'a trier le tableau.
Ce que je cherche c'est à le résumer : si dans mon résultat j'ai 4 fois l'article A, alors au lieu de m'écrire 4 fois l'article A il m'écrit 4 Articles A.

magellan a dit :
Mickoik a dit :
et tu as une idée de comment faire ?


  1. Sub Tri_Article()
  2. 'Macro Dan pour zyglur
  3. Dim plage As Range
  4. Set plage = ActiveSheet.Range("A3:D" & Range("A" & Rows.Count).End(xlUp).Row)
  5. plage.Sort Key1:=Range("A4"), Order1:=xlAscending, Header:=xlGuess, _
  6. OrderCustom:=1, Orientation:=xlTopToBottom
  7. End Sub


m
0
l
a b L Programmation
26 Décembre 2016 17:10:22

Le souci est tout autre alors!
Cela sous-entend sortir dans un nouvel onglet un rapport?
m
0
l
27 Décembre 2016 14:39:28

magellan a dit :
Le souci est tout autre alors!
Cela sous-entend sortir dans un nouvel onglet un rapport?


Pourquoi pas du moment que ça fonctionne ...
m
0
l
27 Décembre 2016 14:43:30

j'ai écris ça. ça fait exactement ce que je veux mais gros problème mon classeur est partagé et la methode sous totaux ne fonctionne pas en mode partagé :fou: 

  1. Worksheets("pour recherche").Range("A2:D500").Clear
  2. Worksheets("pour recherche").Outline.ShowLevels RowLevels:=5
  3.  
  4. Worksheets("Rechercher Client").Range("AV2:AX100").Select
  5. Selection.Copy
  6. Sheets("pour recherche").Select
  7. Range("A2").Select
  8. Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  9. :=True, Transpose:=False
  10. Columns("C:C").Select
  11. Application.CutCopyMode = False
  12. Selection.NumberFormat = "d/m/yyyy"
  13.  
  14. Sheets("pour recherche").Range("A2").Select
  15. ActiveWorkbook.Worksheets("pour recherche").Sort.SortFields.Clear
  16. ActiveWorkbook.Worksheets("pour recherche").Sort.SortFields.Add Key:=Range("C:C") _
  17. , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  18. ActiveWorkbook.Worksheets("pour recherche").Sort.SortFields.Add Key:=Range("B:B") _
  19. , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  20. With ActiveWorkbook.Worksheets("pour recherche").Sort
  21. .SetRange Range("A2:C100")
  22. .Header = xlGuess
  23. .MatchCase = False
  24. .Orientation = xlTopToBottom
  25. .SortMethod = xlPinYin
  26. .Apply
  27. End With
  28. Selection.Subtotal GroupBy:=3, Function:=xlSum, TotalList:=Array(2), _
  29. Replace:=True, PageBreaks:=False, SummaryBelowData:=True
  30. Selection.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(1), _
  31. Replace:=False, PageBreaks:=False, SummaryBelowData:=True
  32. ActiveSheet.Outline.ShowLevels RowLevels:=4
  33. Dim tabl As Range
  34.  
  35. Set tabl = Sheets("pour recherche").Range("A2:C110")
  36.  
  37. derligne1 = Sheets("pour recherche").Range("B500").End(xlUp).Row
  38. derligne2 = Sheets("pour recherche").Range("C500").End(xlUp).Row
  39.  
  40. Sheets("pour recherche").Rows(derligne1).Clear
  41. Sheets("pour recherche").Rows(derligne2).Clear
  42.  
  43. For Each macellule In tabl
  44. If macellule.Value = "" Then
  45. macellule.Clear
  46. End If
  47. Next
  48.  
  49. derligne3 = Sheets("pour recherche").Range("C500").End(xlUp).Row
  50. Set resultat = Sheets("pour recherche").Range("A2:C" & derligne3).SpecialCells(xlVisible)
  51. resultat.Copy Destination:=Sheets("Rechercher Client").Range("W9")
m
0
l
a b L Programmation
9 Janvier 2017 15:30:47

Toujours besoin d'aide ?
m
0
l