Microsoft 365 Macro pour balayer une sélection de plusieurs lignes et colonnes et recherche de mots clefs

[rogue]

Bonjour,

J'aimerai balayer un planning de personnel placé par plusieurs agences. Chaque personne a en préfixe un code correspondant à son agence (exemple MANEMP-DURAN).
L'idée et de sélectionner toutes les plages contenant les diverses personnes placées sur chaque jour, environ 60 noms sur 200 cellules et qu'en appuyant sur le bouton 'MANEMP' toutes les personnes ayant le préfixe de ce MANEMP soit copiés dans une page appelée 'MANEMP', mise à blanc au préalable.
Je réorganiserai par ordre alphabétique pour chasser les doublons (certaines personnes sont placer à double, matin/après-midi)...

Merci par avance pour votre aide.

 

[sylvanu]

Bonjour Rogue, et bienvenu sur XLD,
Pouvez vous fournir un petit fichier test représentatif ET anonyme.
Sans cela, vous allez avoir des réponses vagues ou flou car on ne connait pas le contexte.
Dans l'absolu c'est faisable, en VBA, mais encore faut il avoir une idée de l'organisation de vos données.

 

[rogue]

Bonjour Sylvanu,

Fichier joint avec en exemple 1er jour du mois avec quelques chantiers. La selection est colorée en vert clair. Elle se fait donc une fois le planning remplie puis le bouton 'cargo' passera de case en case pour rechercher les chaine commencant par CARGO et recopiera toutes les concordances sur la page cargo. Merci pour ton aide

 

[sylvanu]

Bonjour Rogue,
Un essai en PJ, mais pas tout bien compris.
1- J'ai pris comme colonne à analyser là où en ligne 7 il y avait quelque chose
2- Il semblerait qu'il y ait d'autres tableaux en dessous ( par ex ligne 33 ligne 60 )
Je n'ai traité que le tableau du haut, sinon adapter.
La macro extrait les noms, supprime les doublons et tri en ordre alpha.

 

[rogue]

Merci Sylvanu,

Mon explication est certainement un peu flou, mais voici une tentative d'éclaircissement :
Le tableau en piece jointe prends le 1 er jour du mois, et effectivement en dessous venaient plus d'informations contenues dans les autres jours du mois. Un pavet de 30 lignes environ par jour. C 'est pourquoi l'activation du bouton se fait apres avoir selectionner les cases a traiter pour un jour. Le nombre de colonne varie fortement d'un jour a l'autre d'ou la selection dynamique et non fixe. Le bouton sera donc inclue dans la partie figée de l ecran pour pouvoir agir sur n'importe quel jour du mois.
Le traitement des informations fonctionne, merci beaucoup, mais il n'y a pas de données fixes. Le triatement des donnees se fat sur les cases sélectionnées par la souris.
J'espere que c'est un peu plus clair

 

[sylvanu]

Bonjour Rogue,

Mon explication est certainement un peu flou

Je confirme.
Un nouvel essai en PJ.
On sélectionne une zone, on appuie sur le bouton, et on ne traite que la zone selectionnée. Avec :

Sub TraiteNouveau()
    Dim cell As Object, NomFeuille$, LigEcr%
    NomFeuille = "CARGO"
    LigEcr = 1                              ' N° ligne écriture
    Sheets(NomFeuille).[A:A].ClearContents  ' Effacement données
    For Each cell In Selection
        If cell.Value Like NomFeuille & "*" Then  ' Si la cellule contient le marqueur
            Sheets(NomFeuille).Cells(LigEcr, "A") = cell.Value    ' On va écrire le nom en CARGO
            LigEcr = LigEcr + 1     ' On incrémente le pointeur d'écriture
            End If
    Next cell
    ' Suppression doublons
    Sheets(NomFeuille).Select
    Columns("A:A").Select
    ActiveSheet.Range("$A$1:$A$1000").RemoveDuplicates Columns:=1, Header:=xlNo
    ' Tri alpha
    ActiveWorkbook.Worksheets(NomFeuille).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(NomFeuille).Sort.SortFields.Add Key:=Range("A1:A1000"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets(NomFeuille).Sort
        .SetRange Range("A1:A1000")
        .Header = xlGuess: .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin: .Apply
    End With
    Range("A1").Select
End Sub

 

[rogue]

Parfait, cela fonctionne à merveille. Un enorme merci Sylvanu