Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2019 Tri d'un listbox à partir de variables tableaux (en "dur" dans le code)

Street filou

XLDnaute Nouveau
Bonjour à tous

voila plusieurs jours que je galère pour adapter le code M. Boisgontier, qui fait référence à une plage de cellule, qui peux être triée via un combo (sur la 3eme colonne) dans un listbox,
hors moi je souhaite faire exactement la même chose mais à partir de variables tableaux "grattées" en dur dans le code comme plus bas et à partir de la 1ère colonne

l'idée est de remonter : boucherie et cremerie dans le combobox => et trier le listbox en fonction

Si quelqu'un pouvait me modifier le code (plus bas) pour pouvoir y arriver ce serait vraiment sympa, car là je sèche fortement !

merci par avance si quelqu'un avait une idée.
bonne soirée à tous




tableau de variables (en vraie il est plus grand 43 lignes et 19 colonnes)

Dim bd(6, 2) As Variant

bd(0, 0) = "boucherie"
bd(0, 1) = "boeuf"

bd(1, 0) = "boucherie"
bd(1, 1) = "lapin"

bd(2, 0) = "boucherie"
bd(2, 1) = "volaille"

bd(3, 0) = "cremerie"
bd(3, 1) = "yahourt"

bd(4, 0) = "cremerie"
bd(4, 1) = "beurre"

bd(5, 0) = "cremerie"
bd(5, 1) = "creme fraiche"


et voici le code original de M. Boisgontier

Dim f, bd
Option Compare Text
---------------------------------------------------------------
Private Sub UserForm_Initialize()

Set f = Sheets("bd")
Set d = CreateObject("Scripting.Dictionary")
bd = f.Range("A2" & f.[A65000].End(xlUp).Row).Value

Me.ListBox1.List = bd
For i = LBound(bd) To UBound(bd)
d(bd(i, 3)) = ""
Next i
Me.ComboBox1.List = d.keys
End Sub
Private Sub ComboBox1_click()
ville = Me.ComboBox1
n = 0
Me.ListBox1.Clear
For i = LBound(bd) To UBound(bd)
If bd(i, 3) = ville Then
Me.ListBox1.AddItem bd(i, 1)
Me.ListBox1.List(n, 1) = bd(i, 2)
Me.ListBox1.List(n, 2) = bd(i, 3)
Me.ListBox1.List(n, 3) = bd(i, 4)
n = n + 1
End If
Next i
End Sub
--------------------------------------------------------------------------------------------
Private Sub B_recup_Click()
'Sheets("Recup").[A2].Resize(Me.ListBox1.ListCount, 4).Value2 = Me.ListBox1.List
'a = Me.ListBox1.Column
'Sheets("Recup").[A2].Resize(UBound(a, 2) + 1, UBound(a) + 1).Value2 = Application.Transpose(a)
a = Me.ListBox1.List
Sheets("Recup").[A2].Resize(UBound(a) + 1, UBound(a, 2) + 1).Value2 = a
End Sub
 

Dudu2

XLDnaute Barbatruc
Bonjour,
Je sais pas si ça va t'aider mais voici un bout de code qui trie un tableau à 2 dimensions
VB:
'------------------------------------
'Sort 2 dimension table on 2 criteria
'------------------------------------
Sub Sort2Dim2Crit(ByRef t As Variant, ByVal SortColumn1 As Integer, ByVal SortColumn2 As Integer)
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim Swap As Long
    Dim tElement() As Variant

    ReDim tElement(LBound(t, 2) To UBound(t, 2))

    k = UBound(t, 1)
    Do
        Swap = 0
        
        For i = LBound(t, 1) To k - 1
            If t(i, SortColumn1) > t(i + 1, SortColumn1) Then
                GoSub Swap
            ElseIf t(i, SortColumn1) = t(i + 1, SortColumn1) Then
                If t(i, SortColumn2) > t(i + 1, SortColumn2) Then GoSub Swap
            End If
        Next i
        
        k = Swap
    Loop While Swap
    Exit Sub
    
Swap:
    Swap = i
    For j = LBound(tElement) To UBound(tElement)
        tElement(j) = t(i, j)
    Next j
    For j = LBound(tElement) To UBound(tElement)
        t(i, j) = t(i + 1, j)
    Next j
    For j = LBound(tElement) To UBound(tElement)
        t(i + 1, j) = tElement(j)
    Next j
    
    Return
End Sub
Exemple d'appel:
VB:
Sub a()
    Dim t As Variant
    t = Range("A1:B6").Value
    Call Sort2Dim2Crit(t, 1, 2)
    Range("A1:B6").Value = t
End Sub
 

Discussions similaires

Réponses
4
Affichages
420
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…