Message-ID: <3A3CD864.73082B2A@free.fr>
Date: Sun, 17 Dec 2000 16:14:44 +0100
From: Laurent Longre <laurent.longre@free.fr>
X-Mailer: Mozilla 4.75 [fr] (Win98; U)
X-Accept-Language: fr,en
MIME-Version: 1.0
Subject: Re: date us
References: <91gib6$9ga$1@wanadoo.fr> <3A3BE439.77C1A317@free.fr> <91hm1k$q64$1@wanadoo.fr>
Content-Type: text/plain; charset=iso-8859-1
Content-Transfer-Encoding: 8bit
Newsgroups: microsoft.public.fr.excel
NNTP-Posting-Host: alyon-102-1-2-180.abo.wanadoo.fr 193.253.230.180
Path: tkmsftngp01!tkmsftngp05
Lines: 1         
Xref: tkmsftngp01 microsoft.public.fr.excel:60627


H&C a &eacute;crit :
> 
> > Tu veux &eacute;liminer les doublons dans la plage, ou alors uniquement dans le
> > ComboBox?
> >
> Uniquement dans le ComboBox.

Bon, dans ce cas il faut que tu utilises un moyen d&eacute;tourn&eacute; et casser la
liaison entre le ComboBox et la plage par ListFillRange.

La solution suivante &eacute;limine les doublons dans le ComboBox *et trie son
contenu* par ordre croissant.

En supposant que la liste d&eacute;roulante s'appelle ComboBox1, qu'elle se
trouve sur la feuille "Feuil1" (nom du module associ&eacute; à la feuille sous
VBA) et que la plage associ&eacute; est Feuil1!A1:A50...

1) Efface le contenu de ListFillRange

2) Copie la proc&eacute;dure suivante dans le module ThisWorkbook :

Private Sub Workbook_Open()
  ChCbx
End Sub

3) Copie la proc&eacute;dure suivante dans le module de la feuille de calcul où
se trouve la plage (Feuil1) :

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
  If Not Intersect(Target, Range(Plage)) Is Nothing Then ChCbx
End Sub

4) Insère un module standard et place les proc&eacute;dures suivantes  dans ce
module :

'==============================================

Option Private Module

Public Const Plage As String = "A1:A50"

Dim Arr, Idx() As Integer
Dim Elt, IdxTemp As Integer
Dim I As Integer

Sub ChCbx()

  Dim Liste(), NElts As Integer
  Dim J As Integer
  
  NElts = Feuil1.Range(Plage).Count
  Arr = Application.Transpose(Feuil1.Range(Plage))
  ReDim Idx(1 To NElts)
  For I = 1 To NElts
    Idx(I) = I
  Next I
  Tri 1, NElts
  ReDim Liste(1 To NElts)
  Liste(1) = Arr(Idx(1))
  J = 1
  For I = 2 To NElts
    If Arr(Idx(I)) <> Arr(Idx(I - 1)) Then
      J = J + 1
      Liste(J) = Arr(Idx(I))
    End If
  Next I
  ReDim Preserve Liste(1 To J)
  Feuil1.ComboBox1.List = Liste
  Feuil1.ComboBox1.ListIndex = 0

End Sub

Private Sub Tri(ByVal B1 As Integer, ByVal H1 As Integer)

  Dim B2 As Integer
  Dim H2 As Integer

  B2 = B1
  H2 = H1
  Elt = Arr(Idx((B1 + H1) \ 2))
  Do While B2 < H2
    Do While B2 < H1 And Arr(Idx(B2)) < Elt
      B2 = B2 + 1
    Loop
    Do While H2 > B1 And Arr(Idx(H2)) > Elt
      H2 = H2 - 1
    Loop
    If B2 < H2 Then
      IdxTemp = Idx(B2)
      Idx(B2) = Idx(H2)
      Idx(H2) = IdxTemp
    End If
    If B2 <= H2 Then
      B2 = B2 + 1
      H2 = H2 - 1
    End If
  Loop
  If H2 > B1 Then Tri B1, H2
  If B2 < H1 Then Tri B2, H1

End Sub

'==============================================

Si tu as du mal à mettre tout ça en oeuvre, je peux t'envoyer un
classeur exemple.

Laurent