XL 2010 Regroupement de données

[fouggy]

Slt tout le forum,

Je souhaiterais regrouper les données de plusieurs colonnes dans une seule.

Actuellement j'utilise la formule à tirer vers le bas =A1&A2 (pour exemple) mais cela prend énormément de temps car j'ai plusieurs feuilles à traiter dans un même classeur. Par ailleurs, il est ensuite impossible de faire des tris classiques car les cellules sont impactées par la formule qu'elles contiennent...

Je pense donc qu'un code est plus approprié.

La démarche pas à pas serait la suivante :

1- Dans la feuille active, considère uniquement par ligne, les cellules des colonnes H à P inclus.

2- Traite toutes les cellules des colonnes H à P ligne par ligne et cherche le seul caractère qui se trouve dans une de ces cellules, ceci à partir de la ligne 1 jusqu'à la dernière ligne où se trouve un caractère.
La dernière ligne marquant la fin du traitement sera celle où il n'y a aucun caractère rencontré dans les cellules des colonne H à P.

3- Va sur la première cellule à traiter, ici H1.
* Si la valeur se trouve dans cette cellule, passe directement à la ligne suivante en H2 pour faire la même recherche.
* Si il n'y a pas de valeur en H1, va en I1. Si la valeur se trouve en I1, couper/coller la valeur en H1 et passer à la ligne suivante en H2 pour faire la même recherche.
* Si il n'y a pas de valeur en H1 ni en I1, va en J1. Si la valeur se trouve en J1, couper/coller la valeur en H1 et passer à la ligne suivante en H2 pour faire la même recherche.

Et ainsi de suite en ligne 1 jusqu'à P1 si effectivement la valeur se trouve dans cette dernière cellule.

Et ainsi de suite pour chaque ligne suivante.

Le processus s'arrête à la ligne qui ne comporte aucun caractère dans aucune des cellules des colonnes H à P.


4- Lorsque le traitement est ainsi terminé sur la feuille active, ouvre la feuille suivante pour relancer le même processus et ainsi de suite jusqu'à la dernière feuille du classeur actif quelque soit le nombre de feuilles à traiter et leur nom.

Voici donc ce que je recherche et que j'ai du mal à codifier.

Merci pour votre aide.

En fichier joint les données de bases et résultats attendus.

Bonne journée

 

[Staple1600]

Bonsoir le fil

Une voie possible (à voir si plus de données)

Sub Test()
Dim c As Range
Application.ScreenUpdating = False
For Each c In Selection.Rows ' Selection juste pour test
c.Sort Key1:=c.Cells(1), Order1:=xlAscending, Header:=xlNo, Orientation:=xlSortRows
Next c
End Sub

 

[fouggy]

Slt Staple 1600,

Merci de ta réponse.

Ta codification aboutie effectivement au résultat attendu, même s'il faut un peu plus de 4mn pour traiter une feuille, excel affiche que le programme ne répond pas pendant la durée du traitement. Mais bon c'est déjà ça.

Peux-tu compléter ton code de telle sorte qu'il s'applique à toutes les autres feuilles du classeur actif ?

Tant pis pour le temps que ça prendra avec une centaine de feuilles à traiter régulièrement, je ferais tourner le code une nuit ou une journée si nécessaire.

 

[Staple1600]

Re
C'est pour cela que j'avais précisé

Une voie possible (à voir si plus de données)

 

[Staple1600]

Re

En attendant une solution à base d'array, est-ce que c'est plus rapide avec cette version modifiée?

Sub Test_II()
Dim rng As Range, c As Range
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    Set rng = Range(Cells(1, "H"), Cells(85, "P"))
For Each c In rng.Rows
c.Sort Key1:=c.Cells(1), Order1:=xlAscending, Header:=xlNo, Orientation:=xlSortRows
Next c
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub

 

[fouggy]

Oupsssssssssss,

En un clin d'oeil maintenant. Un clic, c'est fait... Enorme...

Reste plus qu'à faire en sorte que le code s'applique sur toutes les feuilles du classeur actif, si tu le peux, si tu le veux bien.

En tous les cas un grand merci d'ores et déjà

 

[Staple1600]

Re

A tester (il y aura peut-être des surprises)
J'ai testé sur ton fichier exemple en y dupliquant au préalable plusieurs fois la feuille DonnéesDépart.

Sub mMain()
Dim ws As Worksheet
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
For Each ws In Worksheets
regrouper ws
Next
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub
Private Sub regrouper(Feuille As Worksheet)
Dim rng As Range, c As Range
    Set rng = Feuille.UsedRange
For Each c In rng.Rows
c.Sort Key1:=c.Cells(1), Order1:=xlAscending, Header:=xlNo, Orientation:=xlSortRows
Next c
End Sub

 

[Staple1600]

Re

Remplace la macro regrouper de l'autre message par celle-ci

Private Sub regrouper(Feuille As Worksheet)
Dim rng As Range, Plg As Range, c As Range, DeL&
Set rng = Feuille.UsedRange
DeL = rng.Rows.Count
With Feuille
Set Plg = .Range(.Cells(1, "H"), .Cells(DeL, "P"))
End With
For Each c In Plg.Rows
c.Sort Key1:=c.Cells(1), Order1:=xlAscending, Header:=xlNo, Orientation:=xlSortRows
Next c
End Sub

 

[fouggy]

Bonjour le Fil, Slt Staple,

J'ai pris le temps de faire une série de tests.

C'est tout simplement nickel chrome.

Un grand merci à toi.

Bonne fin de journée

 

[Staple1600]

Bonjour le fil,

fouggy
Reste plus qu'à voir la version qui s'affranchit de l'accès aux cellules pour traiter la chose dans un Array.
Cela devrait être plus rapide avec un gros volumes de lignes à trier.

 

[fouggy]

Oupsssss,

J'ai jeté un oeil sur la fonction Array. C'est assez complexe... J'ai un peu de mal avec la manipulation des tableaux et des fonctions.

Tu bosses dans la programmation ou le vba est simplement une passion ?

 

[Staple1600]

Re,

Je ne bosse pas dans la programmation et ma vrai passion c'est le saucisson
Mais je dis jamais non à une tranche de VBA, arrosée d'un petit Picon

Blague à part, j'ai vu de la lumière à la porte d'XLD, alors je suis rentré.
C'était il y 14 ans déjà, et j'ai pas réussi à trouver la sortie

 

[fouggy]

Re,

Si un challenge te tente, contacte-moi par mail.

fouggy@hotmail.fr

Bonne fin de soirée.

 

[Staple1600]

Bonjour le fil, fouggy

fouggy
Si j'étais moi, je ne publierai pas mon émail sur un forum public !!!
(sauf si j'avais la folle envie de me voir pourrir de spams )

Quant aux challenges, le forum est là pour cela, non ?
De plus si nous sommes plusieurs à tenter de relever un challenge, cela créé de l'émulation et permet donc de découvrir N façons de résoudre un problème

 

[fouggy]

Slt à tous,

Staple

Pas de souci pour les spams, ce n'est qu'une adresse de circonstance, lol.


Entièrement d'accord avec toi sur les notions de challenge, de forum et d'émulation, mais force est de constater que ces challenges en forum concernent une et une seule action spécifique.
Or il s'agit là d'un projet sur lequel je bosse depuis plusieurs années maintenant (2007 !), qui demande à être complété encore par d'autres actions spécifiques (que je mets en place moi-même et d'autres pour lesquelles je me fais aider), voire revu sur certains points pour augmenter sa performance et dont l'exposition sur un forum ne me semble pas appropriée

Voili, voilou.

Bonne fin de we

PS : Je ne me souviens plus où est-ce qu'il faut cliquer pour signifier que le problème est résolu