Listview sans doublons

**Kimaos** · 25/05/2009, 21h38

Bonsoir à tous,

Bien entendu, avant de poser la question, j'ai cherché sur les pages web.

Mais rien, pas de fil, excepté celui là qui indique brièvement la procédure :

http://www.developpez.net/forums/d63...imer-doublons/

Il s'agit d'une listview affichant les colonnes A et C d'une BD de plusieurs colonnes.

Voilà mon code auquel je dois ajouter la suppresion des doublons de la colonne A :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
 
Private Sub UserForm_Initialize()
Dim i As Long
With ListView1
    With .ColumnHeaders
       .Clear
       .Add , , "Nom", 140        'Nom est le titre de la colonne A
       .Add , , "Parenté", 50     'Parenté est le titre de la colonne C
    End With
 .View = lvwReport
 .FullRowSelect = True
 .Gridlines = True
        For i = 1 To Sheets("BD").Range("A65536").End(xlUp).Row
           .ListItems.Add , , Sheets("BD").Cells(i, 1)
           .ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("BD").Cells(i, 3)
        Next
    ListView1.ListItems(1).Selected = False 
    Set ListView1.SelectedItem = Nothing    
End With
End Sub
 
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
    ListView1.Sorted = False
    ListView1.SortKey = ColumnHeader.Index - 1
    If ListView1.SortOrder = lvwAscending Then
        ListView1.SortOrder = lvwDescending
        Else
        ListView1.SortOrder = lvwAscending
    End If
 
    ListView1.Sorted = True
End Sub

Cela m'aiderait beaucoup si quelqu'un, en dépit de ces 30° qui nous tombent sur la tête, pouvait m'indiquer le code à ajouter.

Merci, Kim.

**Archampi** · 26/05/2009, 00h46

Bonsoir Kimaos,

Voici une procédure que j'ai développée pour supprimer les doublons dans un tableau à une dimension.

Tu devras pour l'utiliser, créer un tableau ne comportant qu'une seule colonne qui sera composée de la colonne sur laquelle tu veux faire le test et du numéro de ligne correspondant en utilisant un format de longuieur fixe ex. "000". Tu concatène ces deux informations dans le tableau pour chaque ligne de ton ListView1. Tu appelle la procédure puis tu reprends le résultat pour réalimenter le ListView1.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Public Sub SupprimerDoublons(Entrée() As Variant, Résultats() As Variant)
Dim i As Long, j As Long
Dim Compteur As Long
Dim Doublon As Boolean
 
ReDim Preserve Résultats(1 To 1)
Résultats(1) = Entrée(1)
Compteur = 1
 
For i = 1 To UBound(Entrée)
    For j = 1 To UBound(Résultats)
        If Entrée(i) <> Résultats(j) Then
            Doublon = False
        Else
            Doublon = True
            Exit For
        End If
    Next j
    If Doublon = False Then
        Compteur = Compteur + 1
        ReDim Preserve Résultats(1 To Compteur)
        Résultats(Compteur) = Entrée(i)
    End If
Next i
 
End Sub

À la sortie, le tableau ne comprends que les lignes uniques.

Bonne chance

**Kimaos** · 26/05/2009, 01h10

Bonsoir Archampi, le forum,

Merci de l’orientation, je vais essayer de comprendre la procédure et surtout l’appliquer.

Bonne fin de soirée, Kim.

**Lynx92260** · 26/05/2009, 07h19

Bonjour,

Cette approche est base sur le tri faire par excel dans la feuille voir le code ci-dessous à adapter dans ton projet. Ligne en bleu et gras ajoutes par moi

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Private Sub UserForm_Initialize()
Dim i As Long, sNom As String
    With ListView1
        With .ColumnHeaders
            .Clear
            .Add , , "Nom", 140        'Nom est le titre de la colonne A
            .Add , , "Parenté", 50     'Parenté est le titre de la colonne C
        End With
        .View = lvwReport
        .FullRowSelect = True
        .Gridlines = True
        
        ' J 'effectue le tri Feuille BD en suppossant qu'il y a des entetes
        Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        sNom = ""
        For i = 1 To Sheets("BD").Range("A65536").End(xlUp).Row
            'Si le nom precedent est different on l'ajoute
            If Sheets("BD").Cells(i, 1) <> sNom Then
                .ListItems.Add , , Sheets("BD").Cells(i, 1)
                .ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("BD").Cells(i, 3)
                sNom = Sheets("BD").Cells(i, 1)
            End If
        Next
        ListView1.ListItems(1).Selected = False
        Set ListView1.SelectedItem = Nothing
    End With
End Sub

La listview est alimente sans doublons !!!!!!

A vos claviers et soyez

de d'activer si c'est demande est

!!!!

**Kimaos** · 26/05/2009, 07h44

Bonjour Lynx, le forum,

Erreur 1004 : la methode Sort de la classe Range a echoué.

Kim.

**Lynx92260** · 26/05/2009, 08h26

bonjour

J ai donne l'exemple n'ayant pas ton fichier il faut adapter le code sort de ton appli

Je pars du principe de copier et coller n'est pas forcement la bonne solution

Je donne la trame de l'idée à mettre en place .

La selection de la feuillle "BD" c'est à toi de la compléter on peut pas deviner !!

Il faut ajouter genre pseudo code ci dessous

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
 
en supposant il y a trois colonnes A B C  et 1000 lignes renseignées 
Dim lFin as long
 
lFin = derniere ligne renseigne à toi de compléter  il faut s'exercer c'est pédagogique !!!!!!
 
Sheets("BD").Range("A1:C" & lFin ).select 
 
La commande sort d 'excel  ensuite ......
 
par exemple

Le code est tape direct dans ce message

Donc corrige au besoin .........

**Kimaos** · 26/05/2009, 21h40

Bonsoir Lynx, le forum,

Voici le fichier

Merci, Kim.

**Lynx92260** · 26/05/2009, 23h48

Bonjour,

Voici le code à remplacer dans UserForm_Initialize()

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
 
Private Sub UserForm_Initialize()
Dim i As Long, sNom As String
    With ListView1
        With .ColumnHeaders
            .Clear
            .Add , , "Nom", 140        'Nom est le titre de la colonne A
            .Add , , "Parenté", 50     'Parenté est le titre de la colonne C
        End With
        .View = lvwReport
        .FullRowSelect = True
        .Gridlines = True
 
        ' J 'effectue le tri Feuille BD en suppossant qu'il y a des entetes
        Sheets("BD").Select
        i = Sheets("BD").Range("A65536").End(xlUp).Row
        Sheets("BD").Range("A1:E" & i).Select
        Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        Sheets("BD").Cells(1, 1).Select
        sNom = ""
        For i = 1 To Sheets("BD").Range("A65536").End(xlUp).Row
            'Si le nom precedent est different on l'ajoute
            If Sheets("BD").Cells(i, 1) <> sNom Then
                .ListItems.Add , , Sheets("BD").Cells(i, 1)
                .ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("BD").Cells(i, 3)
                sNom = Sheets("BD").Cells(i, 1)
            End If
        Next
        ListView1.ListItems(1).Selected = False
        Set ListView1.SelectedItem = Nothing
    End With
End Sub

Bonne continuation

**Kimaos** · 27/05/2009, 00h02

Lynx, tu es un amour

Juste un petit souci, le bouton d'appel de la listview est placé dans une feuille autre que la feuille BD, le souci est que l'appel de la listview affiche en même temps la feuille BD. Peux tu m'indiquer le code pour parer à ce cet affichage de la feuille BD non souhaité ?

Merci, Kim

**Lynx92260** · 27/05/2009, 08h12

Bonjour,

Il suffit de rajouter une ligne dans l'evenement initialize de l'userform

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Private Sub UserForm_Initialize()
......
Set ListView1.SelectedItem = Nothing

Sheets("Accueil").Select

......
End Sub

Voilà tout simplement

**Jeannot45** · 27/05/2009, 08h28

Ou encore utiliser la propriété ScreenUpdating (qui a pour effet de geler les mouvement de l'écran):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Application.ScreenUpdating = False
... Traitement
Application.ScreenUpdating = True

Bonne continuation

**Kimaos** · 28/05/2009, 01h27

Bonsoir Lynx, Jeannot, le forum,

Merci pour les indications !

Avec la solution de Lynx, il y a quand même affichage de la feuille "BD" pendant une seconde, et retour ensuite à la feuille "Accueil".

http://sd-1.archive-host.com/membres...7/Visites2.xls

Et pour ce qui est de Application.ScreenUpdating (False/True) en fin et début de code, je l’ai testé, mais ça ne fonctionne pas, et pourtant le classeur est assez épuré pour penser qu’il y aurait une autre procédure en parallèle qui l’empêche de fonctionner.

http://sd-1.archive-host.com/membres...7/Visites3.xls

Bonne fin de soirée, Kim.

**laetitia** · 28/05/2009, 06h55

bonjour le fil le forum c est normal il faut pas remettre a true a la fin dans Initialize

en debut de code seulement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.ScreenUpdating = False

dans ton bouton fermer

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Private Sub CommandButton1_Click()
Unload Me: Sheets(1).Activate
End Sub

**Lynx92260** · 28/05/2009, 08h16

Bonjour Kimaos et les intervenants

Bon ajoute effectivement la methode screeenupdating cela donne ce code ci dessous ligne en bleu gras à ajouter dans le code.....

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Private Sub UserForm_Initialize()
Dim i As Long, sNom As String
    With ListView1
        With .ColumnHeaders
            .Clear
            .Add , , "Nom", 120
            .Add , , "Parenté", 50
        End With
        .View = lvwReport
        .FullRowSelect = True
        .Gridlines = True
        Application.ScreenUpdating = False
        Sheets("BD").Select
        i = Sheets("BD").Range("A65536").End(xlUp).Row
        Sheets("BD").Range("A2:E" & i).Select
        Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        Sheets("BD").Cells(1, 1).Select
        sNom = ""
        For i = 2 To Sheets("BD").Range("A65536").End(xlUp).Row
            If Sheets("BD").Cells(i, 1) <> sNom Then
                .ListItems.Add , , Sheets("BD").Cells(i, 1)
                .ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("BD").Cells(i, 3)
                sNom = Sheets("BD").Cells(i, 1)
            End If
        Next
        ListView1.ListItems(1).Selected = False
        Set ListView1.SelectedItem = Nothing
        Sheets("Accueil").Select
        Application.ScreenUpdating = True

    End With