Supprimer les lignes à blanc d'une listbox

Le 20/05/2024 à 15:37

Bonjour à tous,

Je tourne un peu beaucoup en rond pour supprimer des lignes vides d'une listbox.

image

Pourquoi mettre des lignes à blanc dans un premier temps ? vous me direz.

hé bien parce que je n'ai pas trouvé d'autre solution pour pouvoir passer ma double condition sans bug.

Private Sub test_Click()
    Dim i%, j%, a%, b%, x%, nom$, prenom$, tb2 As ListObject, ws6 As Worksheet, ws2 As Worksheet
    Application.ScreenUpdating = False
    Set ws2 = Sheets("SousNombres")
    Set tb2 = ws2.ListObjects("Reclasst")
    Set ws6 = Sheets("Listes")
    For i = 1 To 15
        a = Len(ws6.Cells(i, 1).Value) 'nbre caractères clé
        b = InStr(1, ws6.Cells(i, 1).Value, "-") 'position du -
        nom = Left(ws6.Cells(i, 1).Value, b - 1)
        prenom = Right(ws6.Cells(i, 1).Value, a - b)
        Me.group.AddItem
        Me.group.List(Me.group.ListCount - 1, 0) = x 'N°
        Me.group.List(Me.group.ListCount - 1, 1) = nom
        Me.group.List(Me.group.ListCount - 1, 2) = prenom
        Me.group.List(Me.group.ListCount - 1, 3) = "metier"
        x = x + 1
    Next i
    'enlever de la liste si en sousnombre avec un groupe
        For i = 1 To tb2.ListRows.Count
            For j = 0 To Me.group.ListCount - 1
                If tb2.DataBodyRange(i, 2).Value = Me.group.List(j, 1) And tb2.DataBodyRange(i, 3).Value = Me.group.List(j, 2) Then
                    If tb2.DataBodyRange(i, 5).Value = "" And tb2.DataBodyRange(i, 6).Value <> "" And tb2.DataBodyRange(i, 2).Value = Me.group.List(j, 1) _
                        And tb2.DataBodyRange(i, 3).Value = Me.group.List(j, 2) Then
                        Me.group.List(j, 0) = ""
                        Me.group.List(j, 1) = ""
                        Me.group.List(j, 2) = ""
                        Me.group.List(j, 3) = ""
                        Me.group.List(j, 4) = ""
                    End If
                End If
            Next j
        Next i
    'largeurs cols liste
    If Me.group.ListCount <> 0 Then
        Me.group.ColumnWidths = "20;60;60;80;40" 'largeur cols listbox
    End If
End Sub

Je pensais que ce code les supprimerait, mais non.

    'supprimer lignes à blanc
    For j = 0 To Me.group.ListCount - 1
         If Me.group.List(j, 0) = "" Then
            Me.group.RemoveItem(j)
         End If
    Next j

Merci de votre attention ou votre aide.

19forum.xltm (36.27 Ko)
Le 20/05/2024 à 15:56

Bonjour,

après avoir mis en commentaire votre double boucle i et j, je me retrouve avec USF sans lignes blanche allant de 0 à 14 avec seulement "métier".
Comment cela doit-il fonctionner ?

image

@ bientôt

LouReeD

Le 20/05/2024 à 16:06

Bonjour Lou reed,

"En commentaire" ? Je sais pas comment tu as fait, mais quand je clique sur le bouton test, mes lignes commencent à 5 .

Si tu pouvais expliquer en détail.

Merci.

Le 20/05/2024 à 16:30

Voilà :

Private Sub test_Click()
    Dim i%, j%, a%, b%, x%, nom$, prenom$, tb2 As ListObject, ws6 As Worksheet, ws2 As Worksheet
    Application.ScreenUpdating = False
    Set ws2 = Sheets("SousNombres")
    Set tb2 = ws2.ListObjects("Reclasst")
    Set ws6 = Sheets("Listes")
    For i = 1 To 15
        a = Len(ws6.Cells(i, 1).Value) 'nbre caractères clé
        b = InStr(1, ws6.Cells(i, 1).Value, "-") 'position du -
        nom = Left(ws6.Cells(i, 1).Value, b - 1)
        prenom = Right(ws6.Cells(i, 1).Value, a - b)
        Me.group.AddItem
        Me.group.List(Me.group.ListCount - 1, 0) = x 'N°
        Me.group.List(Me.group.ListCount - 1, 1) = nom
        Me.group.List(Me.group.ListCount - 1, 2) = prenom
        Me.group.List(Me.group.ListCount - 1, 3) = "metier"
        x = x + 1
    Next i
    'B-enlever de la liste si en sousnombre avec un groupe
'        For i = 1 To tb2.ListRows.Count
'            For j = 0 To Me.group.ListCount - 1
'                If tb2.DataBodyRange(i, 2).Value = Me.group.List(j, 1) And tb2.DataBodyRange(i, 3).Value = Me.group.List(j, 2) Then
'                    If tb2.DataBodyRange(i, 5).Value = "" And tb2.DataBodyRange(i, 6).Value <> "" And tb2.DataBodyRange(i, 2).Value = Me.group.List(j, 1) _
'                        And tb2.DataBodyRange(i, 3).Value = Me.group.List(j, 2) Then
'                        Me.group.List(j, 0) = ""
'                        Me.group.List(j, 1) = ""
'                        Me.group.List(j, 2) = ""
'                        Me.group.List(j, 3) = ""
'                        Me.group.List(j, 4) = ""
'                    End If
'                End If
'            Next j
'        Next i
    'largeurs cols liste
    If Me.group.ListCount <> 0 Then
        Me.group.ColumnWidths = "20;60;60;80;40" 'largeur cols listbox
    End If
End Sub

@ bientôt

LouReeD

Le 20/05/2024 à 16:44

Merci, j'ai besoin de réfléchir à la solution.

Le 20/05/2024 à 19:58

Bonsoir,

n'ayant pas compris le fonctionnement du besoin je ne puis vous aider plus pour le moment.
Bon courage.

@ bientôt

LouReeD

Le 21/05/2024 à 07:19

Bonjour,

Avec quelques heures de sommeil et les yeux en face des trous, j'ai réglé le problème.

En faisant des boucles séparées pour mettre des lignes d'un tableau dans le dictionnaire ou pour enlever ces lignes du dictionnaire, plus besoin d'aller effacer des lignes de la liste de la colonne "1er choix".

    For i = 1 To tb3.ListRows.Count
        If tb3.DataBodyRange(i, 2).Value = Me.metierG.Value Then
            abrg = tb3.DataBodyRange(i, 5).Value
        End If
    Next i
    drc = ws4.Cells(1, 100).End(xlToLeft).Column
    For j = 4 To drc Step 4
        drn = ws4.Cells(500, j).End(xlUp).Row
        For i = 2 To drn
            If ws4.Cells(1, j).Value = Me.metierG.Value Then
                cle2 = ws4.Cells(i, j - 2).Value & "-" & ws4.Cells(i, j - 1).Value
                If Not dic2.exists(cle2) Then dic2.Add cle2, ""
            End If
        Next i
    Next j
    drc = ws4.Cells(1, 100).End(xlToLeft).Column
    For j = 4 To drc Step 4
        drn = ws4.Cells(500, j).End(xlUp).Row
        For i = 2 To drn
            For k = 1 To tb2.ListRows.Count
                 If ws4.Cells(1, j).Value = Me.metierG.Value _
                     And ws4.Cells(i, j - 2).Value = tb2.DataBodyRange(k, 2).Value And ws4.Cells(i, j - 1).Value = tb2.DataBodyRange(k, 3).Value _
                     And Mid(tb2.DataBodyRange(k, 6).Value, 1, 4) = abrg Then
                     cle2 = ws4.Cells(i, j - 2).Value & "-" & ws4.Cells(i, j - 1).Value
                     If dic2.exists(cle2) Then dic2.Remove cle2
                 End If
             Next k
        Next i
    Next j
image image

Merci lou reed

Le 21/05/2024 à 08:34

bonjour LouReeD , Trucky93,

avec un dictionaire, mais je ne comprends pas exactement ce que vous voulez faire, donc un essai

10forum1.xlsm (38.84 Ko)
Le 21/05/2024 à 10:57

Bonjour Bsalv,

Merci pour ta réponse, c'est toujours intéressant de voir une autre façon de coder.

Il s'agit de sortir des groupes de 10 à 30 candidats de groupes de choix faits dans le cadre d'un projet d'orientation, mais j'arrive au bout là.

Cà devrait aller pour continuer seul, avec peut-être des demandes comme celle-ci sur certains points.

Merci

Rechercher des sujets similaires à "supprimer lignes blanc listbox"