Microsoft 365 do while ordre alphabétique

[treuyyyzzert]

Bonjour, comment peut-on faire une boucle qui demande un mot à inscrire en colonne (avec inputbox), et qui s'arrête une fois que le mot rentré est inférieur dans l'ordre alphabétique que le mot précédent ? Merci.

 

[Dranreb]

Bonjour.
Essayez L = WorksheetFunction.Match(LeTexe, LaPlage)

 

[Dranreb]

Ce code par exemple demande un texte par une InputBox puis l'inscrit dans une nouvelle ligne en colonne A à partir de la ligne 2 s'il n'y figure pas encore. S'il y figure déjà, il sélectionne la ligne où il se trouve, le signale par une MsgBox et abandonne le traitement.

Option Explicit
Option Compare Text
Sub Test()
   Dim LaPlage As Range, LeTexte As String, L As Long
   Set LaPlage = Intersect(ActiveSheet.[A2:A1000000], ActiveSheet.UsedRange)
   LeTexte = InputBox("Le texte")
   If LaPlage Is Nothing Then
      L = 1
   ElseIf LaPlage(1).Value <= LeTexte Then
      L = 1
      If LaPlage.Rows.Count > 1 Then L = WorksheetFunction.Match(LeTexte, LaPlage)
      If LaPlage(L).Value = LeTexte Then
         Rows(L + 1).Select
         MsgBox """" & LeTexte & """ existe déjà.", vbExclamation
         Exit Sub: End If
      L = L + 1
   Else
      L = 1: End If
   L = L + 1: Rows(L).Insert
   ActiveSheet.Cells(L, "A").Value = LeTexte
   End Sub

Remarque: sans 3ième argument précisé, la WorksheetFunction.Match procède par recherche dichotomique et non pas séquentielle. Mais elle renvoie le numéro du plus grand élément <= l'argument cherché. Il faut donc ajouter 1 pour avoir le numéro du 1er élément à décaler qui suit, puis encore 1 si tout ça commence à la ligne 2 pour avoir le numéro de celle à insérer. Mais d'abord elle planterait s'il n'existe pas d'élément <= l'argument cherché ou si la plage comporte moins de 2 lignes. C'est pourquoi je teste ça avant d'essayer de l'employer.