Microsoft 365 Afficher une liste précédemment filtrée dans une combobox

premion

XLDnaute Junior
Bonsoir à tous à nouveau,

J'ai créé un Userform qui me permet d'afficher un certain nombres d'information issues d'une feuille Excel dont une liste déroulante qui doit me permettre d'afficher seulement les lignes précédemment filtrées. Or dans l'UserFrom le Combobox m'affiche tout sans filtre.

Pourriez-vous m'éclairer ?

Je joins mon fichier exemple!

Mille mercis par avance!

Philippe
 

Pièces jointes

  • Pipeline ExcelDown.xlsm
    59.5 KB · Affichages: 7

Dudu2

XLDnaute Barbatruc
Bonjour,
VB:
    'arr_data = onglet.Range(onglet.Cells(2, 1), onglet.Cells(derniere_ligne, 2))
    arr_data = onglet.Range(onglet.Cells(2, 1), onglet.Cells(derniere_ligne, 2)).SpecialCells(xlCellTypeVisible).Value
Ensuite il faut que tu adaptes éventuellement ton code car les indices de la ComboBox ne correspondent plus à ceux du Range non filtré.
 
Dernière édition:

premion

XLDnaute Junior
Merci Dudu2 pour la réponse rapide.
La modification ne me récupère que la première ligne filtrée, maintenant!
Le filtre s'applique sur tableau issue d'une requête Power Query
Je ne comprends pas!
 

Pièces jointes

  • Pipeline ExcelDown.xlsm
    61.8 KB · Affichages: 5

Dudu2

XLDnaute Barbatruc
La modification ne me récupère que la première ligne filtrée, maintenant!
1634141822569.png
 

premion

XLDnaute Junior
Bon, je viens d'essayer de mon côté et je comprends pourquoi je dis que ça ne marche pas (c'est un bon début, non?)!

Si les lignes ne sont pas contiguës dans le fichier de base, il ne les affiche pas...

Avant filtre:
1634144814221.png

Après filtrage:

1634144854802.png


Et en effet, il semble ne pas correctement répercuter les autres cellules dans les combobox. Il faut que je rajoute aussi SpecialCells(xlCellTypeVisible).Value aussi sur chacune des itérations:
TBx_country.SpecialCells(xlCellTypeVisible).Value = onglet.Cells(i, 3)
c'est correct?

Merci encore pour votre aide et bonne soirée

Philippe
 

Dudu2

XLDnaute Barbatruc
Et oui parce que le Range issu de .SpecialCells(xlCellTypeVisible) est multi-areas et que l'affectation dans le tableau ne prend que la 1ère area.
J'essaie de trouver une instruction simple pour copier les valeurs de toutes les areas sans boucler sur chacune d'elles. Mais je crois qu'on n'y coupera pas 😨.
 
Dernière édition:

Dudu2

XLDnaute Barbatruc
D'un autre coté, y a autre chose qui n'est pas 100% sous contrôle. C'est:
Code:
derniere_ligne = onglet.Cells(Rows.Count, 1).End(xlUp).Row
Vu que ceci s'applique à un tableau structuré tu n'obtiendras jamais que la dernière ligne du tableau (316), qu'elle soit valorisée ou pas. Dans le contexte ça fonctionne mais je suppose que ce n'est pas ce que tu pensais récupérer.

De plus .End(xlUp).Row est sensible au filtre. De sorte que si tu utilises cette instruction dans une feuille filtrée et que tu recherches la "vraie" dernière ligne valorisée, si cette "vraie" dernière est filtrée elle ne sera pas prise en compte. Cette instruction n'est valide que si tu recherches la dernière ligne filtrée d'une colonne.

Quand tu recherches la "vraie" dernière ligne d'une colonne, filtrée ou pas, ou la dernière colonne d'une ligne je te recommande de passer par ces fonctions.
 

Dudu2

XLDnaute Barbatruc
J'ai un peu élargi le scope de la fonction si on la prend pour un usage général.
Ça se résume en 2 modifs:
- il peut y avoir des Ranges de 1 cellule et là l'assignation classique ne fonctionne plus
- il peut y avoir des Ranges de largeurs différentes
VB:
'----------------------------------------------------------------------
'Valorise une table des valeurs d'un Range multi-Areas ce qui peut être
'le cas d'un Range filtré obtenu avec .SpecialCells(xlCellTypeVisible)
'----------------------------------------------------------------------
Function ValuesOfMultiAreaRange(MultiAreaRange As Range) As Variant
    Dim Area As Range
    Dim TabCellVal(1 To 1, 1 To 1) As Variant
    Dim TabAreaVal() As Variant
    Dim TabVal() As Variant
    Dim MaxDim2 As Integer
    Dim NbVal As Long
    Dim iArea As Long
    Dim i As Long
    Dim j As Long
  
    If MultiAreaRange Is Nothing Then GoTo ExitFunction
  
    'Table des valeurs des Areas
    ReDim TabAreaVal(1 To MultiAreaRange.Areas.Count)

    'Chargement des valeurs des Areas dans la Table des valeurs des Areas
    For iArea = 1 To MultiAreaRange.Areas.Count
        If MultiAreaRange.Areas(iArea).Cells.Count = 1 Then
            TabCellVal(1, 1) = MultiAreaRange.Areas(iArea).Cells(1, 1).Value
            TabAreaVal(iArea) = TabCellVal
        Else
            TabAreaVal(iArea) = MultiAreaRange.Areas(iArea).Value
        End If
      
        NbVal = NbVal + UBound(TabAreaVal(iArea), 1)
        If UBound(TabAreaVal(iArea), 2) > MaxDim2 Then MaxDim2 = UBound(TabAreaVal(iArea), 2)
    Next iArea

    'Tableau des valeurs de toutes les Areas
    ReDim TabVal(1 To NbVal, 1 To MaxDim2)
    NbVal = 0

    'Copie des valeurs des Areas dans le Tableau des valeurs de toutes les Areas
    For iArea = 1 To MultiAreaRange.Areas.Count
        For i = 1 To UBound(TabAreaVal(iArea), 1)
            For j = 1 To UBound(TabAreaVal(iArea), 2)
                TabVal(NbVal + i, j) = TabAreaVal(iArea)(i, j)
            Next j
        Next i
        NbVal = NbVal + UBound(TabAreaVal(iArea), 1)
    Next iArea

ExitFunction:
    ValuesOfMultiAreaRange = TabVal
End Function

Et ton code:
VB:
If derniere_ligne > 1 Then
    arr_data = ValuesOfMultiAreaRange(onglet.Range(onglet.Cells(2, 1), onglet.Cells(derniere_ligne, 2)).SpecialCells(xlCellTypeVisible))
    ComboBox_modification.ColumnCount = 2
    ComboBox_modification.List = arr_data
End If

Edit: Ou directement:
VB:
If derniere_ligne > 1 Then
    ComboBox_modification.ColumnCount = 2
    ComboBox_modification.List = ValuesOfMultiAreaRange(onglet.Range(onglet.Cells(2, 1), onglet.Cells(derniere_ligne, 2)).SpecialCells(xlCellTypeVisible))
End If
 
Dernière édition:

Discussions similaires

Réponses
4
Affichages
2 K
Compte Supprimé 979
C
Réponses
19
Affichages
2 K

Statistiques des forums

Discussions
311 740
Messages
2 082 041
Membres
101 879
dernier inscrit
Arthur M