Doublons

Doublons - VB/VBA/VBS - Programmation

Marsh Posté le 17-03-2005 à 18:06:40    

Bonjour à tous  :hello:  
Je voudrais savoir si il existe un petit bout de code simple  
pour éliminer les doublons dons une liste pour en faire une listbox.
Merci d'avance. :D


---------------
FoH
Reply

Marsh Posté le 17-03-2005 à 18:06:40   

Reply

Marsh Posté le 17-03-2005 à 19:55:34    

On va imaginer que ta liste est la colonne A et qu'elle commence à la ligne 1
 

Code :
  1. Me.List1.Clear
  2. For i = 1 To Range("A1" ).End(xlDown).Row
  3.     If Me.List1.ListCount = 0 Then Me.List1.AddItem Range("A" & i).Value
  4.     m = 0
  5.     For j = 0 To Me.List1.ListCount - 1
  6.         If Range("A" & i).Value = Me.List1.List(j) Then
  7.         m = 1
  8.         End If
  9.     Next
  10.     If m = 0 Then Me.List1.AddItem Range("A" & i).Value
  11. Next


Il ne faut pas d'espace dans la liste avant insertion (sinon l'espace arrête la boucle).
 
Voilà.

Reply

Marsh Posté le 18-03-2005 à 18:26:43    

C'est génial ce truc  :wahoo:  mais j'ai un petit souci car sur une feuille simple avec une colonne simple c'est simple  :pt1cable:  mais moi c'est sur une page bien precise(elle s'appelle PROG) et la colonne à dédoublonner est un groupe de cellules(nommé TRNST2) qui démarre de f2 à f131. :ange:  
 
Merci pour le premier code! :love:


---------------
FoH
Reply

Marsh Posté le 18-03-2005 à 21:42:16    

ben ca va donner :

Code :
  1. Me.List1.Clear
  2.      For i = 2 To 132
  3.          If Me.List1.ListCount = 0 Then Me.List1.AddItem Range("F" & i).Value
  4.          m = 0
  5.          For j = 0 To Me.List1.ListCount - 1
  6.              If Range("F" & i).Value = Me.List1.List(j) Then
  7.              m = 1
  8.              End If
  9.          Next
  10.          If m = 0 Then Me.List1.AddItem Range("F" & i).Value
  11.      Next


 

Reply

Marsh Posté le 19-03-2005 à 17:12:18    

Je spécifie à quel endroit que c'est la page "PROG" :??:  
 
(Je débute... :sweat: )


---------------
FoH
Reply

Marsh Posté le 19-03-2005 à 17:55:03    

"Me" correspond à mon Userform? :??:  
"List1" correspond à ma Listbox? :??:  
Je mets Worksheets("PROG" ). devant Range? :??:  
 
 :pt1cable:  :heink:  :pt1cable:  :heink:  :pt1cable:  :heink:  :pt1cable:  :heink:  :pt1cable:


---------------
FoH
Reply

Marsh Posté le 19-03-2005 à 19:09:25    

bonsoir,
bien que je ne sois pas un adepte du userform je pense que c'est celà.
Tu mets ce code dans la macro initialize de ton USF, éventuellement tu modifies en fonction du nom de ton Listbox et tu rajoutes ton
worksheets("PROG" ) devant tous les "range" et ça devrait être bon.
 
Chez moi ça donne ça :

Code :
  1. Private Sub UserForm_Initialize()
  2. Me.ListBox1.Clear
  3.      For i = 2 To 132
  4.          If Me.ListBox1.ListCount = 0 Then Me.ListBox1.AddItem Range("F" & i).Value
  5.          m = 0
  6.          For j = 0 To Me.ListBox1.ListCount - 1
  7.              If Range("F" & i).Value = Me.ListBox1.List(j) Then
  8.              m = 1
  9.              End If
  10.          Next
  11.          If m = 0 Then Me.ListBox1.AddItem Range("F" & i).Value
  12.      Next
  13. End Sub


Ok ?


Message édité par galopin01 le 19-03-2005 à 19:10:36
Reply

Marsh Posté le 19-03-2005 à 19:49:15    

Je vais essayer ça, merci! :jap:


---------------
FoH
Reply

Marsh Posté le 19-03-2005 à 20:21:53    

J'ai fais ça:
 
Private Sub ValZik_Click()
' POUR L'EXPORT DU RESULTAT DES FILTRES VERS LA ZONE DE TEXTE
' EN PASSANT PAR UNE ZONE DE TRANSITION
 
    Application.Goto Reference:="Artiste"
    Selection.Copy
    Application.Goto Reference:="TRNST2"
    Sheets("PROG" ).Select
    Range("F1" ).Select
    ActiveSheet.Paste
 
      For i = 2 To 132
          If ZIKOS.KZartiste.ListCount = 0 Then ZIKOS.KZartiste.AddItem Worksheets("PROG" ).Range("F" & i).Value
          m = 0
          For j = 0 To ZIKOS.KZartiste.ListCount - 1
    If Worksheets("PROG" ).Range("F" & i).Value = ZIKOS.KZartiste.List(j) Then
              m = 1
End If
          Next
          If m = 0 Then ZIKOS.KZartiste.AddItem Worksheets("PROG" ).Range("F" & i).Value
      Next
 
    ZIKOS.KZartiste.RowSource = "TRNST2"
End Sub
 
Et ça marche PAS!!! :fou:    :pt1cable:  :pt1cable:  
Où me suis-je trompé?


---------------
FoH
Reply

Marsh Posté le 19-03-2005 à 21:55:00    

On reprend un peu avant :
 
PROG est le nom d'un classeur ou d'une feuille ?
Si c'est un classeur, c'est Workbooks, si c'est une feuille c'est Sheets ...

Reply

Marsh Posté le 19-03-2005 à 21:55:00   

Reply

Marsh Posté le 20-03-2005 à 20:07:59    

Bonsoir,
Ben, là t'as tout faux...
La Proc que je t'ai donné tu la colles intégralement dans le module de Code de TonUSF (en double-cliquant sur l'USF)
Tu fais ton ValZik_Click d'un coté...
à la fin tu écris
MonUSF.Load
MonUsF.Show
End Sub
...et ça devrait faire.
Ok ?
 
Tout sur les USF et VBA ici
A+

Reply

Marsh Posté le 23-03-2005 à 18:22:22    

J'ai fais ça...
--> ZIKOS est mon userform
--> KZartiste est ma listbox
--> Worksheets("PROG" ).Range("F" ) est la liste à dedoublonner (son vrai nom est TRNST2)

 
 
Private Sub UserForm_Initialize()
' pour initialiser la KZartiste sans doublons pourrave
 
 
        For i = 2 To 132
    If ZIKOS.KZartiste.ListCount = 0 Then ZIKOS.KZartiste.AddItem Worksheets("PROG" ).Range("F" & i).Value
        m = 0
        For j = 0 To ZIKOS.KZartiste.ListCount - 1
    If Worksheets("PROG" ).Range("F" & i).Value = ZIKOS.KZartiste.List(j) Then
        m = 1
    End If
    Next
        If m = 0 Then ZIKOS.KZartiste.AddItem Worksheets("PROG" ).Range("F" & i).Value
    Next
End Sub
 
ET CA MARCHE PAS  :cry:


---------------
FoH
Reply

Marsh Posté le 23-03-2005 à 21:25:54    

La il va falloir que tu m'expliques.  :??:  
 
Je l'ai testé deux fois chez moi et ca passe nikel.  :pt1cable:  
 
Il n'y a aucun doublon en plus (testé).
 

Citation :

ET CA MARCHE PAS  :cry:

--> Peut être si tu nous donnais quelques infos ??  :heink:  

Reply

Marsh Posté le 23-03-2005 à 21:59:06    

bonsoir,
ci joint un 'tit classeur démo ici
Ok ?

Reply

Marsh Posté le 30-03-2005 à 22:59:57    

Bonsoir galopin01,
Tu vas rire (j'espère) mais j'arrive pas... :cry:  
 
Comment puis-je t'envoyer mon fichier pour que tu puisses y jeter un oeil si tu as le temps?


---------------
FoH
Reply

Marsh Posté le 08-04-2005 à 19:14:27    

Du coup j'ai trouvé et adapté ça, provenant du site d'une gentile Cathy :love: :
 
Private Sub ValZik_Click()
' POUR L'EXPORT DU RESULTAT DES FILTRES VERS LA ZONE DE TEXTE
' EN PASSANT PAR UNE ZONE DE TRANSITION
 
    Application.Goto Reference:="Artiste"
    Selection.Copy
    Application.Goto Reference:="TRNST2"
    Sheets("PROG" ).Select
    Range("F1" ).Select
    ActiveSheet.Paste
     
    Dim flleNouv As Worksheet, PROG2 As Worksheet
    Dim rDoublon As Range
 
      Set PROG2 = ActiveSheet
      Set rDoublon = Selection
      'exécute un filtre élaboré sans critère et sans doublon
      rDoublon.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
      'ajoute une feuille
      Set flleNouv = Worksheets.Add
      'sélectionne uniquement les cellules visibles
      rDoublon.SpecialCells(xlCellTypeVisible).Copy
      ' on colle ces cellules dans la nouvelle feuille
      flleNouv.Range("A1" ).PasteSpecial xlPasteAll
      'on affiche tout pour annuler le filtre
      PROG2.ShowAllData
      'on efface tous le contenu de la plage
      rDoublon.ClearContents
      ' on copie les données de la nouvelle feuille et on les colle dans la sélection
      flleNouv.Range("A1" ).CurrentRegion.Copy rDoublon.Cells(1)
      'on supprime la nouvelle feuille
      Application.DisplayAlerts = False
      flleNouv.Delete
      Application.DisplayAlerts = False
       
       
       
    ZIKOS.KZartiste.RowSource = "TRNST2"
End Sub
 
C'est lent c'est lourd mais ça marche :heink: .
 
Merci encore à tous. :bounce:

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed