regrouper sur un tableau excel

D'abord bravo pour l'adaptation de la macro.

On peut accélérer la procédure comme ceci :

A ) Dans la procédure, remplace cette ligne de code
C.EntireRow.Delete
Par
C = ""


B ) à la toute fin de la macro, ajoute cette ligne de code

Rg.SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'Ajout
Application.ScreenUpdating = True
Application.EnableEvents = True


Cela devrait diminuer le temps de traitement de la procédure.

MichD

J'oubliais, as-tu déclaré TOUTES les variables de la procédure au début
de celle-ci ?

Toutes les valeurs numériques entières Dim MyVar as Long
Les variables numériques avec décimale Dim MyVar1 as Double
Les variables contenant du texte : Dim MyVar2 As String

Faire cela diminue aussi le temps de traitement de manière substantielle.

MichD

Le lundi 09 Mai 2016 à 23:23 par MichD :

J'oubliais, as-tu déclaré TOUTES les variables de la
procédure au début
de celle-ci ?

Toutes les valeurs numériques entières Dim MyVar as Long
Les variables numériques avec décimale Dim MyVar1 as Double
Les variables contenant du texte : Dim MyVar2 As String

Faire cela diminue aussi le temps de traitement de manière
substantielle.

MichD

Non, je n'ai pas déclaré mes variables. Peux-tu m'expliquer comment dois-je faire stp?

Le lundi 09 Mai 2016 à 23:23 par MichD :

J'oubliais, as-tu déclaré TOUTES les variables de la
procédure au début
de celle-ci ?

Toutes les valeurs numériques entières Dim MyVar as Long
Les variables numériques avec décimale Dim MyVar1 as Double
Les variables contenant du texte : Dim MyVar2 As String

Faire cela diminue aussi le temps de traitement de manière
substantielle.

MichD

Voici la macro modifié

'J'ai ajouté la référence suivante à partir du menu
'Outils / références / 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, ColC
Set D = CreateObject("Scripting.dictionary")

Application.ScreenUpdating = False
Application.EnableEvents = False

'Identifier la totalité des cellules de la colonne A
With Worksheets("Feuil2")
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

'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
ColB = ColB & C.Offset(, 1).Value & Chr(10)
'En colonne C, on veut faire la somme des valeur monétaire
ColC = ColC & C.Offset(, 2).Value & Chr(10)
ColD = ColD & C.Offset(, 3).Value & Chr(10)
ColE = ColE & C.Offset(, 4).Value & Chr(10)
ColF = ColF & C.Offset(, 5).Value & Chr(10)
ColG = ColG & C.Offset(, 6).Value & Chr(10)
ColH = ColH & C.Offset(, 7).Value & Chr(10)
ColI = ColI & C.Offset(, 8).Value & Chr(10)
ColJ = ColJ & C.Offset(, 9).Value & Chr(10)
ColK = ColK & C.Offset(, 10).Value & Chr(10)
ColL = ColL & C.Offset(, 11).Value & Chr(10)
ColM = ColM & C.Offset(, 12).Value & Chr(10)
ColN = ColN & C.Offset(, 13).Value & Chr(10)
ColO = ColO & C.Offset(, 14).Value & Chr(10)
ColP = ColP & C.Offset(, 15).Value & Chr(10)
ColQ = ColQ & C.Offset(, 16).Value & Chr(10)
ColR = ColR & C.Offset(, 17).Value & Chr(10)
ColS = ColS & C.Offset(, 18).Value & Chr(10)
ColT = ColT & C.Offset(, 19).Value & Chr(10)
ColU = ColU & C.Offset(, 20).Value & Chr(10)
ColV = ColV & C.Offset(, 21).Value & Chr(10)
ColW = ColW & C.Offset(, 22).Value & Chr(10)
ColX = ColX & C.Offset(, 23).Value & Chr(10)
ColY = ColY & C.Offset(, 24).Value & Chr(10)
ColZ = ColZ & C.Offset(, 25).Value & Chr(10)
ColAA = ColAA & C.Offset(, 26).Value & Chr(10)
ColAB = ColAB & C.Offset(, 27).Value & Chr(10)
ColAC = ColAC & C.Offset(, 28).Value & Chr(10)
ColAD = ColAD & C.Offset(, 29).Value & Chr(10)
ColAE = ColAE & C.Offset(, 30).Value & Chr(10)
ColAF = ColAF & C.Offset(, 31).Value & Chr(10)
ColAG = ColAG & C.Offset(, 32).Value & Chr(10)
ColAH = ColAH & C.Offset(, 33).Value & Chr(10)
ColAI = ColAI & C.Offset(, 34).Value & Chr(10)
ColAJ = ColAJ & C.Offset(, 35).Value & Chr(10)
ColAK = ColAK & C.Offset(, 36).Value & Chr(10)
ColAL = ColAL & C.Offset(, 37).Value & Chr(10)
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)
'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
Application.ScreenUpdating = True
Application.EnableEvents = True
Rg.SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'Ajout
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Comme ceci :

Sauf erreur, je n'ai pas vu le contenu de chacune des colonnes...

'Sur la première ligne du module :
Option Explicit

'----------------------------------------------------------
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("Feuil2")
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

'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
ColB = ColB & C.Offset(, 1).Value & Chr(10)
'En colonne C, on veut faire la somme des valeur monétaire
ColC = ColC & C.Offset(, 2).Value & Chr(10)
ColD = ColD & C.Offset(, 3).Value & Chr(10)
ColE = ColE & C.Offset(, 4).Value & Chr(10)
ColF = ColF & C.Offset(, 5).Value & Chr(10)
ColG = ColG & C.Offset(, 6).Value & Chr(10)
ColH = ColH & C.Offset(, 7).Value & Chr(10)
ColI = ColI & C.Offset(, 8).Value & Chr(10)
ColJ = ColJ & C.Offset(, 9).Value & Chr(10)
ColK = ColK & C.Offset(, 10).Value & Chr(10)
ColL = ColL & C.Offset(, 11).Value & Chr(10)
ColM = ColM & C.Offset(, 12).Value & Chr(10)
ColN = ColN & C.Offset(, 13).Value & Chr(10)
ColO = ColO & C.Offset(, 14).Value & Chr(10)
ColP = ColP & C.Offset(, 15).Value & Chr(10)
ColQ = ColQ & C.Offset(, 16).Value & Chr(10)
ColR = ColR & C.Offset(, 17).Value & Chr(10)
ColS = ColS & C.Offset(, 18).Value & Chr(10)
ColT = ColT & C.Offset(, 19).Value & Chr(10)
ColU = ColU & C.Offset(, 20).Value & Chr(10)
ColV = ColV & C.Offset(, 21).Value & Chr(10)
ColW = ColW & C.Offset(, 22).Value & Chr(10)
ColX = ColX & C.Offset(, 23).Value & Chr(10)
ColY = ColY & C.Offset(, 24).Value & Chr(10)
ColZ = ColZ & C.Offset(, 25).Value & Chr(10)
ColAA = ColAA & C.Offset(, 26).Value & Chr(10)
ColAB = ColAB & C.Offset(, 27).Value & Chr(10)
ColAC = ColAC & C.Offset(, 28).Value & Chr(10)
ColAD = ColAD & C.Offset(, 29).Value & Chr(10)
ColAE = ColAE & C.Offset(, 30).Value & Chr(10)
ColAF = ColAF & C.Offset(, 31).Value & Chr(10)
ColAG = ColAG & C.Offset(, 32).Value & Chr(10)
ColAH = ColAH & C.Offset(, 33).Value & Chr(10)
ColAI = ColAI & C.Offset(, 34).Value & Chr(10)
ColAJ = ColAJ & C.Offset(, 35).Value & Chr(10)
ColAK = ColAK & C.Offset(, 36).Value & Chr(10)
ColAL = ColAL & C.Offset(, 37).Value & Chr(10)
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)
'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
Application.ScreenUpdating = True
Application.EnableEvents = True
Rg.SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'Ajout
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
'----------------------------------------------------------

Désolé, je n'avais par relu la procédure jusqu'à la fin.

Remplacé ceci :

Application.ScreenUpdating = True
Application.EnableEvents = True
Rg.SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'Ajout
Application.ScreenUpdating = True
Application.EnableEvents = True


Par

Rg.SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'Ajout
Application.ScreenUpdating = True
Application.EnableEvents = True

c'est suffisant!


MichD

Tu dois retenir cette procédure, tu as oublié toute une section de la
procédure, celle qui consiste à enlever le dernier caractère "Chr(10)
pour chacune des variables dans le milieu de la procédure.

Dans le haut du module
Option Explicit

'------------------------------------------
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("Feuil2")
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

'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
ColB = ColB & C.Offset(, 1).Value & Chr(10)
'En colonne C, on veut faire la somme des valeur monétaire
ColC = ColC & C.Offset(, 2).Value & Chr(10)
ColD = ColD & C.Offset(, 3).Value & Chr(10)
ColE = ColE & C.Offset(, 4).Value & Chr(10)
ColF = ColF & C.Offset(, 5).Value & Chr(10)
ColG = ColG & C.Offset(, 6).Value & Chr(10)
ColH = ColH & C.Offset(, 7).Value & Chr(10)
ColI = ColI & C.Offset(, 8).Value & Chr(10)
ColJ = ColJ & C.Offset(, 9).Value & Chr(10)
ColK = ColK & C.Offset(, 10).Value & Chr(10)
ColL = ColL & C.Offset(, 11).Value & Chr(10)
ColM = ColM & C.Offset(, 12).Value & Chr(10)
ColN = ColN & C.Offset(, 13).Value & Chr(10)
ColO = ColO & C.Offset(, 14).Value & Chr(10)
ColP = ColP & C.Offset(, 15).Value & Chr(10)
ColQ = ColQ & C.Offset(, 16).Value & Chr(10)
ColR = ColR & C.Offset(, 17).Value & Chr(10)
ColS = ColS & C.Offset(, 18).Value & Chr(10)
ColT = ColT & C.Offset(, 19).Value & Chr(10)
ColU = ColU & C.Offset(, 20).Value & Chr(10)
ColV = ColV & C.Offset(, 21).Value & Chr(10)
ColW = ColW & C.Offset(, 22).Value & Chr(10)
ColX = ColX & C.Offset(, 23).Value & Chr(10)
ColY = ColY & C.Offset(, 24).Value & Chr(10)
ColZ = ColZ & C.Offset(, 25).Value & Chr(10)
ColAA = ColAA & C.Offset(, 26).Value & Chr(10)
ColAB = ColAB & C.Offset(, 27).Value & Chr(10)
ColAC = ColAC & C.Offset(, 28).Value & Chr(10)
ColAD = ColAD & C.Offset(, 29).Value & Chr(10)
ColAE = ColAE & C.Offset(, 30).Value & Chr(10)
ColAF = ColAF & C.Offset(, 31).Value & Chr(10)
ColAG = ColAG & C.Offset(, 32).Value & Chr(10)
ColAH = ColAH & C.Offset(, 33).Value & Chr(10)
ColAI = ColAI & C.Offset(, 34).Value & Chr(10)
ColAJ = ColAJ & C.Offset(, 35).Value & Chr(10)
ColAK = ColAK & C.Offset(, 36).Value & Chr(10)
ColAL = ColAL & C.Offset(, 37).Value & Chr(10)
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
'------------------------------------------

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

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

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.

En plus, ton vrai fichier possède combien de lignes de données?


MichD