OVH Cloud OVH Cloud

regrouper sur un tableau excel

41 réponses
Avatar
Lindt
Bonjour toute la communauté,
Je travaille actuellement sur un fichier excel qui fait des extractions de requête d'une base de données Access.
Le problème ce que mon fichier contient plusieurs fois les mêmes commandes. Je m'explique une commande pouvant avoir plusieurs articles, celle-ci se répète autant de fois qu'il y'a d'article.
Pour éviter ceci je voulais savoir s'il y'avais un moyen de regrouper tous les articles par rapport à la commande ou de les fusionner. C'est à dire qu'en face de chaque commande les articles apparaissent dans une cellule.
Je ne sais pas si c'est clair ce que j'ai écrit :/
Merci d'avance pour votre aide :)

10 réponses

1 2 3 4 5
Avatar
lindt
Le mardi 10 Mai 2016 à 21:10 par MichD :
Le 10/05/16 à 11:06, lindt a écrit :
Le vendredi 29 Avril 2016 à 11:54 par Lindt :
Bonjour toute la communauté,
Je travaille actuellement sur un fichier excel qui fait des extractions de
requête d'une base de données Access.
Le problème ce que mon fichier contient plusieurs fois les mêmes
commandes. Je m'explique une commande pouvant avoir plusieurs articles,
celle-ci se répète autant de fois qu'il y'a d'article.
Pour éviter ceci je voulais savoir s'il y'avais un moyen de regrouper
tous les articles par rapport à la commande ou de les fusionner. C'est
à dire qu'en face de chaque commande les articles apparaissent dans
une
cellule.
Je ne sais pas si c'est clair ce que j'ai écrit :/
Merci d'avance pour votre aide :)



Ah c'est génial, ça fonctionne bien. Merci
énormément mais comme je suis
chiante, juste un petit détail par rapport à la mise en forme de
celui-ci j'ai
des gros bloc vide, que je ne comprend pas. Je t'envoie un exemple en
pièce
jointe, si tu peux pas ce n'est pas grave, c'est déjà pas mal.
Merci encore
Lindt







Où est le fichier joint ou l'adresse où obtenir ce fichier?
Tu peux utiliser Cjoint.com pour envoyer ton fichier. Tu publies
l'adresse que tu obtiendras ici.


MichD


Bonjour,
Voici mon fichier
http://www.cjoint.com/c/FElgbGJygNb
J'ai un très grand nombre de ligne qui change en fonction de mes extraction.
Avatar
MichD
Ton fichier : http://www.cjoint.com/c/FElkzUqT8BX
La macro est dans le module1 de ton fichier.


MichD
Avatar
MichD
Désolé, je n'ai envoyé une mauvaise version de la macro.
Regarde dans le module1 de ce fichier :
http://www.cjoint.com/c/FElnVfX0TuX


La macro :

Attention, on coupure de ligne par le navigateur de messagerie.

Cette procédure requiert la référence suivante:
Microsoft Scripting RunTime


Sub Compilation()
Dim D As Dictionary, Elt As Variant, Adr As String, G As Range
Dim Suite As String, Rg As Range, C As Range, T As Long
Dim ColB As String, ColC As String, ColD As String, ColE As String
Dim ColF As String, ColG As String, ColH As String, ColI As Double
Dim ColJ As Double, ColK As Double, ColL As String, ColM As Double
Dim ColN As Double, ColO As String, ColP As String, ColQ As String
Dim ColR As String, ColS As String, ColT As Double, ColU As String
Dim ColV As String, ColW As String, ColX As String, ColY As String
Dim ColZ As String, ColAA As String, ColAB As String, ColAC As String
Dim ColAD As Double, ColAE As String, ColAF As String, ColAG As String
Dim ColAH As String, ColAI As Double, ColAJ As String, ColAK As String
Dim ColAL As String, ColAM As String


Set D = CreateObject("Scripting.dictionary")

Application.ScreenUpdating = False
Application.EnableEvents = False

'Identifier la totalité des cellules de la colonne A
With Worksheets("Feuil1")
Set Rg = .Range("A1:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With

'On place dans l'objet dictionnary seulement les valeurs
'qui sont au moins en double dans la colonne A afin de ne traiter
'que ces lignes...
For Each C In Rg
If C <> "" Then
If Application.CountIf(Rg, C.Value) > 1 Then
If Not D.Exists(C.Value) Then
D.Add C.Value, C.Row
End If
End If
End If
Next

'La ligne de code "On error resume next a été ajouté car si une colonne
est vide,
'ce type de ligne de code retourne une erreur ColB = Left(ColB,
Len(ColB) - 1)
'En utilisant cette ligne de code, je ne suis pas obligé de tester le
contenu
'de la cellule pour chacune des cellules...

On Error Resume Next
'Une boucle pour chaque valeur en double ou plus trouvée
For Each Elt In D.Keys
With Rg
'recherche de la permière valeur en colonne A (rg)
Set C = .Find(Elt)
If Not C Is Nothing Then
'lorsque trouvé, identifier l'adresse de la première cellule
'afin d'arrêter la boucle suivante
Adr = C.Address
Do
'Dans ma colonne b (C.Offset(, 1).Value) des valeur texte
'donc on doit concaténer
'Dans ma colonne b (C.Offset(, 1).Value) des valeur texte
'donc on doit concaténer
If C.Offset(, 1) <> "" Then ColB = ColB & C.Offset(,
1).Value & Chr(10)
'En colonne C, on veut faire la somme des valeur monétaire
If C.Offset(, 2) <> "" Then ColC = ColC & C.Offset(,
2).Value & Chr(10)
If C.Offset(, 3) <> "" Then ColD = ColD & C.Offset(,
3).Value & Chr(10)
If C.Offset(, 4) <> "" Then ColE = ColE & C.Offset(,
4).Value & Chr(10)
If C.Offset(, 5) <> "" Then ColF = ColF & C.Offset(,
5).Value & Chr(10)
If C.Offset(, 6) <> "" Then ColG = ColG & C.Offset(,
6).Value & Chr(10)
If C.Offset(, 7) <> "" Then ColH = ColH & C.Offset(,
7).Value & Chr(10)
If C.Offset(, 8) <> "" Then ColI = ColI & C.Offset(,
8).Value & Chr(10)
If C.Offset(, 9) <> "" Then ColJ = ColJ & C.Offset(,
9).Value & Chr(10)
If C.Offset(, 10) <> "" Then ColK = ColK & C.Offset(,
10).Value & Chr(10)
If C.Offset(, 11) <> "" Then ColL = ColL & C.Offset(,
11).Value & Chr(10)
If C.Offset(, 12) <> "" Then ColM = ColM & C.Offset(,
12).Value & Chr(10)
If C.Offset(, 13) <> "" Then ColN = ColN & C.Offset(,
13).Value & Chr(10)
If C.Offset(, 14) <> "" Then ColO = ColO & C.Offset(,
14).Value & Chr(10)
If C.Offset(, 15) <> "" Then ColP = ColP & C.Offset(,
15).Value & Chr(10)
If C.Offset(, 16) <> "" Then ColQ = ColQ & C.Offset(,
16).Value & Chr(10)
If C.Offset(, 17) <> "" Then ColR = ColR & C.Offset(,
17).Value & Chr(10)
If C.Offset(, 18) <> "" Then ColS = ColS & C.Offset(,
18).Value & Chr(10)
If C.Offset(, 19) <> "" Then ColT = ColT & C.Offset(,
19).Value & Chr(10)
If C.Offset(, 20) <> "" Then ColU = ColU & C.Offset(,
20).Value & Chr(10)
If C.Offset(, 21) <> "" Then ColV = ColV & C.Offset(,
21).Value & Chr(10)
If C.Offset(, 22) <> "" Then ColW = ColW & C.Offset(,
22).Value & Chr(10)
If C.Offset(, 23) <> "" Then ColX = ColX & C.Offset(,
23).Value & Chr(10)
If C.Offset(, 24) <> "" Then ColY = ColY & C.Offset(,
24).Value & Chr(10)
If C.Offset(, 25) <> "" Then ColZ = ColZ & C.Offset(,
25).Value & Chr(10)
If C.Offset(, 26) <> "" Then ColAA = ColAA & C.Offset(,
26).Value & Chr(10)
If C.Offset(, 27) <> "" Then ColAB = ColAB & C.Offset(,
27).Value & Chr(10)
If C.Offset(, 28) <> "" Then ColAC = ColAC & C.Offset(,
28).Value & Chr(10)
If C.Offset(, 29) <> "" Then ColAD = ColAD & C.Offset(,
29).Value & Chr(10)
If C.Offset(, 30) <> "" Then ColAE = ColAE & C.Offset(,
30).Value & Chr(10)
If C.Offset(, 31) <> "" Then ColAF = ColAF & C.Offset(,
31).Value & Chr(10)
If C.Offset(, 32) <> "" Then ColAG = ColAG & C.Offset(,
32).Value & Chr(10)
If C.Offset(, 33) <> "" Then ColAH = ColAH & C.Offset(,
33).Value & Chr(10)
If C.Offset(, 34) <> "" Then ColAI = ColAI & C.Offset(,
34).Value & Chr(10)
If C.Offset(, 35) <> "" Then ColAJ = ColAJ & C.Offset(,
35).Value & Chr(10)
If C.Offset(, 36) <> "" Then ColAK = ColAK & C.Offset(,
36).Value & Chr(10)
If C.Offset(, 37) <> "" Then ColAL = ColAL & C.Offset(,
37).Value & Chr(10)
If C.Offset(, 38) <> "" Then ColAM = ColAM & C.Offset(,
38).Value & Chr(10) 'ainsi de suite pour les 40 colonnes
selon que tu veux
'concaténer le contenu de la colonne, en faire la sommme
'ou encore dénombre le nombre d'unité.

'Trouver la cellule suivante de la colonne A qui correspond au critère
Set C = .FindNext(C)
'Condition pour sortir de la boucle
Loop Until C.Address = Adr

'Enlève de dernier retour à la ligne Chr(10)
'à adapter pour les autres lignes selon leur type de contenu
ColB = Left(ColB, Len(ColB) - 1)
ColC = Left(ColC, Len(ColC) - 1)
ColD = Left(ColD, Len(ColD) - 1)
ColE = Left(ColE, Len(ColE) - 1)
ColF = Left(ColF, Len(ColF) - 1)
ColG = Left(ColG, Len(ColG) - 1)
ColH = Left(ColH, Len(ColH) - 1)
ColI = Left(ColI, Len(ColI) - 1)
ColJ = Left(ColJ, Len(ColJ) - 1)
ColK = Left(ColK, Len(ColK) - 1)
ColL = Left(ColL, Len(ColL) - 1)
ColM = Left(ColM, Len(ColM) - 1)
ColN = Left(ColN, Len(ColN) - 1)
ColO = Left(ColO, Len(ColO) - 1)
ColP = Left(ColP, Len(ColP) - 1)
ColQ = Left(ColQ, Len(ColQ) - 1)
ColR = Left(ColR, Len(ColR) - 1)
ColS = Left(ColS, Len(ColS) - 1)
ColT = Left(ColT, Len(ColT) - 1)
ColU = Left(ColU, Len(ColU) - 1)
ColV = Left(ColV, Len(ColV) - 1)
ColX = Left(ColX, Len(ColX) - 1)
ColY = Left(ColY, Len(ColY) - 1)
ColZ = Left(ColZ, Len(ColZ) - 1)
ColAA = Left(ColAA, Len(ColAA) - 1)
ColAB = Left(ColAB, Len(ColAB) - 1)
ColAC = Left(ColAC, Len(ColAC) - 1)
ColAD = Left(ColAD, Len(ColAD) - 1)
ColAE = Left(ColAE, Len(ColAE) - 1)
ColAF = Left(ColAF, Len(ColAF) - 1)
ColAG = Left(ColAG, Len(ColAG) - 1)
ColAH = Left(ColAH, Len(ColAH) - 1)
ColAI = Left(ColAI, Len(ColAI) - 1)
ColAJ = Left(ColAJ, Len(ColAJ) - 1)
ColAK = Left(ColAK, Len(ColAK) - 1)
ColAL = Left(ColAL, Len(ColAL) - 1)
ColAM = Left(ColAM, Len(ColAM) - 1)

'Aucun traitement pour la colonne C à faire
'ColD = ....
.Find C

'La boucle suivante va remettre dans chacune des colonnes
'la valeur qui devrait apparaître...
Do
If T = 0 Then
T = T + 1
C.Offset(, 1).Value = ColB
C.Offset(, 2).Value = ColC
C.Offset(, 3).Value = ColD
C.Offset(, 4).Value = ColE
C.Offset(, 5).Value = ColF
C.Offset(, 6).Value = ColG
C.Offset(, 7).Value = ColH
C.Offset(, 8).Value = ColI
C.Offset(, 9).Value = ColJ
C.Offset(, 10).Value = ColK
C.Offset(, 11).Value = ColL
C.Offset(, 12).Value = ColM
C.Offset(, 13).Value = ColN
C.Offset(, 14).Value = ColO
C.Offset(, 15).Value = ColP
C.Offset(, 16).Value = ColQ
C.Offset(, 17).Value = ColR
C.Offset(, 18).Value = ColS
C.Offset(, 19).Value = ColT
C.Offset(, 20).Value = ColU
C.Offset(, 21).Value = ColV
C.Offset(, 22).Value = ColW
C.Offset(, 23).Value = ColX
C.Offset(, 24).Value = ColY
C.Offset(, 25).Value = ColZ
C.Offset(, 26).Value = ColAA
C.Offset(, 27).Value = ColAB
C.Offset(, 28).Value = ColAC
C.Offset(, 29).Value = ColAD
C.Offset(, 30).Value = ColAE
C.Offset(, 31).Value = ColAF
C.Offset(, 32).Value = ColAG
C.Offset(, 33).Value = ColAH
C.Offset(, 34).Value = ColAI
C.Offset(, 35).Value = ColAJ
C.Offset(, 36).Value = ColAK
C.Offset(, 37).Value = ColAL
C.Offset(, 38).Value = ColAM

'Ainsi de suite pour les autres colonnes
Set C = .FindNext(C)
Else
Set G = C.Offset(-1)
C = ""
Set C = .FindNext(G)
End If
Loop Until C.Address = Adr
T = 0
'Remettre toutes les valeurs des variables soient à "" pour texte
'ou à 0 pour les valeur numériques pour traiter la valeur suivante.
ColB = "": ColC = "": ColD = "": ColE = "": ColF = "": ColG = ""
ColH = "": ColI = 0: ColJ = 0: ColK = 0: ColL = "": ColM = 0
ColN = 0: ColO = "": ColP = "": ColQ = "": ColR = "": ColS = ""
ColT = 0: ColU = "": ColV = "": ColW = "": ColX = "": ColY = 0
ColZ = "": ColAA = "": ColAB = "": ColAC = "": ColAD = 0
ColAE = "": ColAF = "": ColAG = "": ColAH = "": ColAI = 0
ColAJ = "": ColAK = "": ColAL = "": ColAM = ""


End If
End With
Next
Rg.SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'Ajout
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Avatar
lindt
Le vendredi 29 Avril 2016 à 11:54 par Lindt :
Bonjour toute la communauté,
Je travaille actuellement sur un fichier excel qui fait des extractions de
requête d'une base de données Access.
Le problème ce que mon fichier contient plusieurs fois les mêmes
commandes. Je m'explique une commande pouvant avoir plusieurs articles,
celle-ci se répète autant de fois qu'il y'a d'article.
Pour éviter ceci je voulais savoir s'il y'avais un moyen de regrouper
tous les articles par rapport à la commande ou de les fusionner. C'est
à dire qu'en face de chaque commande les articles apparaissent dans une
cellule.
Je ne sais pas si c'est clair ce que j'ai écrit :/
Merci d'avance pour votre aide :)


ça ne fonctionne pas sur mon fichier mais ce n'est pas grave, je te remercie énormément pour tout ce que t'as fait pour moi et d'avoir été patient. Et encore merci :)
Lindt
Avatar
MichD
ça ne fonctionne pas sur mon fichier mais ce n'est pas grave, je te remercie
énormément pour tout ce que t'as fait pour moi et d'avoir été patient. Et encore




Tu as prise la macro dans ce classeur ?
http://www.cjoint.com/c/FElnVfX0TuX

Qu'est-ce qui ne fonctionne pas? Qu'est-ce qui se passe lorsque tu
exécutes la macro. Tu dois être plus explicite dans ton message.


MichD
Avatar
lindt
Le mercredi 11 Mai 2016 à 17:09 par MichD :
ça ne fonctionne pas sur mon fichier mais ce n'est pas grave, je te
remercie
énormément pour tout ce que t'as fait pour moi et d'avoir
été patient. Et encore





Tu as prise la macro dans ce classeur ?
http://www.cjoint.com/c/FElnVfX0TuX

Qu'est-ce qui ne fonctionne pas? Qu'est-ce qui se passe lorsque tu
exécutes la macro. Tu dois être plus explicite dans ton message.


MichD


Bonjour MichD
En faite la macro fonctionne, mais les bloc blanc sont toujours là, mais pas grave je vais faire avec.
merci :)
Avatar
MichD
En faite la macro fonctionne, mais les bloc blanc sont toujours là, mais pas
grave je vais faire avec.



J'ai fait un tableau exemple. Lorsque j'exécute la macro, je ne vois
aucun espace blanc dont tu parles.

Voici le fichier exemple :
http://www.cjoint.com/c/FEmkZKUU07X

Je ne comprends pas vraiment où tu vois ces espaces "blancs".

Cependant, comme tu importes des données dans Excel, il se peut que les
cellules vides de ton tableau ne soient pas totalement vides et qu'elles
contiennent un caractère (espace insécable - Chr(160) -), visuellement,
tu ne vois rien dans la cellule, mais la présence de ce caractère
pourrait générer des blancs comme tu l'énonces.

Comme je n'ai pas vu ton tableau de données, il m'est difficile de
savoir ce qui se passe!


MichD
Avatar
MichD
Tu peux faire disparaître le chr(160) de tout ton tableau de données
comme ceci :

Utilise la commande "Remplacer" du menu "Rechercher et sélectionner"

Dans la case "Rechercher", tu insères le caractère chr(160) pour ce faire :

Maintiens enfoncer la touche "Alt" de gauche de la barre d'espacement et
tu tapes 0160
Tu laisses la case "Remplacer par" vide.
Et tu cliques sur le bouton "Remplacer tout".

N.B. Assure-toi que dans les "options" de la fenêtre, la case "Totalité
du contenu de la cellule" n'est pas cochée.


MichD
Avatar
lindt
Le jeudi 12 Mai 2016 à 13:29 par MichD :
Tu peux faire disparaître le chr(160) de tout ton tableau de
données
comme ceci :

Utilise la commande "Remplacer" du menu "Rechercher et
sélectionner"

Dans la case "Rechercher", tu insères le caractère
chr(160) pour ce faire :

Maintiens enfoncer la touche "Alt" de gauche de la barre d'espacement
et
tu tapes 0160
Tu laisses la case "Remplacer par" vide.
Et tu cliques sur le bouton "Remplacer tout".

N.B. Assure-toi que dans les "options" de la fenêtre, la case
"Totalité
du contenu de la cellule" n'est pas cochée.


MichD


Bonjour MichD
Ta macro fonctionne bien juste quelques détails qu'il a fallu que je modifie par rapport au contenu de mes colonnes.
Cependant, j'ai une dernière demande stp, promis ça sera la dernière :). J'ai d'autres colonnes mise à part la première, qui comportent des informations identiques, j'aimerai qu'elles soient fusionnées aussi comme t'as fait pour la première. J'ai essayé de le faire mais j'y arrives pas.
Voici un fichier exemple: http://www.cjoint.com/c/FEnhqiKW6rb
Lindt
Avatar
MichD
Mon fichier exemple ici : http://www.cjoint.com/c/FEnlxf2Cz8X

Tu copies tout le contenu du module1 dans le module de ton application.

En début de la procédure "Compilation" assure-toi que le nom de l'onglet
de la feuille où sont les données correspond au nom de la feuille à
traiter dans ton application.

With Worksheets("Feuil1") '<<----ICI
Feuille = .Name

La procédure de charge d'enlever le caractère "Chr(160)". Nul besoin de
l'enlever avant de lancer la procédure.

Évidemment, cela va augmenter la durée de traitement.

MichD
1 2 3 4 5