Tri par ordre alphabétique et appel function

Bonjour

Voilà dans l'exemple ci dessous je vais un recherche V amélioré

1. Ma macro test va chercher les mots clés dans la feuille Data Deviations colonne AG

2. elle compare les mots grâce à la matrice présent en colonne S&T de la feuille Workon

3. elle les renvoie en colonne AI de la feuille Data Deviations

La deuxième étape serait un tri alphabétique des résultats, par exemple dans la cellule AI2 feuille Data déviations, je souhaite trier les résultats par ordre alphabétique.

J'y suis arriver avec le module 11, seulement je souhaite convertir la function en sub pour l'appliquer directement à la colonne AI, de plus comment puis je faire pour afficher les résultats avec un retour chariot entre chaque mot dans la cellule?

Merci

Re,

Il suffit d'ajouter la fonction à ta sub Test()

Sub Test()
  Application.ScreenUpdating = False
  Dim WsS As Worksheet, WsC As Worksheet
  Dim Cel As Range, c As Range
  Dim Position As Integer, MemoPos As Integer
  Set WsS = Worksheets("Workon")
  Set WsC = Worksheets("Data-Deviations")

  Sheets("Data-Deviations").Activate
  Range("AI2:AI1000000").ClearContents

  For Each Cel In WsC.Range("AG2:AG" & WsC.Range("AG" & Rows.Count).End(xlUp).Row)
    MemoPos = 1000
    For Each c In WsS.Range("S2:S" & WsS.Range("S" & Rows.Count).End(xlUp).Row)
      Position = InStr(Cel, c)
      If Position > 0 Then
        If Cel.Offset(0, 2) <> "" And InStr(Cel.Offset(0, 2), c.Offset(0, 1)) = 0 Then
          ' ligne And InStr(Cel.Offset(0, 2), C.Offset(0, 1)) = 0 supprime doublon
          If Position < MemoPos Then
            MemoPos = Position
            Cel.Offset(0, 2) = c.Offset(0, 1) & Chr(10) & Cel.Offset(0, 2)
          Else
            Cel.Offset(0, 2) = Cel.Offset(0, 2) & Chr(10) & c.Offset(0, 1)
          End If
        Else
          Cel.Offset(0, 2) = c.Offset(0, 1)
          MemoPos = Position
        End If
      End If
    Next c
    ' Appliquer le tri à la cellule
    Cel.Offset(0, 2).Value = TriCell(Cel.Offset(0, 2).Value)
  Next Cel
  Set WsC = Nothing: Set WsS = Nothing
  Application.ScreenUpdating = True
End Sub

A+

Impec merci

Bonjour,

Merci d'éviter les doublons et de poster sur plusieurs forums, tu fais bosser les gens pour rien !

https://forum.excel-pratique.com/post382651.html#p382651

eric

Pas de violence c'est les vacances....

Merci quand même à ceux qui m'ont répondue ( plus ou moins en rouge et en majuscules...)

Si tu suivais tes multiples demandes ce qui est le minimum de respect pour les intervenants qui prennent du temps pour toi tu aurais vu que je t'ai répondu sur l'autre fil.

eric

Ok super.

Bon on va pas s'énerver on remercie tout le monde.

pour info

BrunoM45 a écrit :

Re,

Merci d'ouvrir un nouveau fil avec un titre explicite et un fichier exemple

Et tu en penses quoi de ma proposition ? Je ne vois rien sur le fil en question.

Connaissant les réactions épidermiques de brunoM45 à ce sujet ça m'étonnerait fort qu'il t'ait conseillé de poster également sur d'autres forums.

Nous sommes nombreux à avoir les poils qui se hérissent lorsqu'on voit que c'est résolu ailleurs après avoir passé du temps sur un fichier, parce que le demandeur n'a pas eu la décence de le signaler ou la patience d'attendre 24h sans réponse avant de poster ailleurs.

C'est une règle qu'il vaut mieux respecter, au bout d'un an tu as dû le remarquer. Fais-en ce que tu veux...

J'en profite pour signaler aux personnes intéressées une extension intéressante sur Chrome :

https://chrome.google.com/webstore/detail/pearls-extension/mccffpojdcohdkefnbfhfdcklpcagdlc?utm_source=chrome-app-launcher-info-dialog

Les pseudos listés à éviter apparaissent bien visibles en surlignés sur n'importe quel site.

eric