Microsoft 365 Filtrer dans une variable-tableau : possible ?

[BenHarber]

Bonjour le Forum,
Une petite question de principe (…et je m’en excuse par avance si elle est complètement saugrenue 😌) :

Est-ce qu’il est « VBAment » possible, à partir d’une VARIABLE-TABLEAU (comportant x lignes et y colonnes), de « filtrer » certaines données pour les coller sur une feuille Excel ? (je sais faire la manip à partir d’un tableau Excel mais je me demandais si on pourrait le faire à partir d’une variable-tableau).

Merci d’avance pour vos idées…et votre indulgence !

 

[BenHarber]

Bonjour à tous, 🙂

Par filtrer une variable tableau, je ne sais pas trop ce que tu entends 😏
Sinon un p'tit test avec la fonction Filter :

Sub test()
    Dim x, Arr()
    With Sheets("Pannes").Cells(1).CurrentRegion
        x = Filter(.Parent.Evaluate("transpose(if((" & .Columns(8).Address & "=""FABRICATION""),row(1:" & .Rows.Count & ")))"), False, 0)
        If UBound(x) = -1 Then Exit Sub
        Arr = Application.Index(.Value2, Application.Transpose(x) _
                                        , Evaluate("column(" & .Rows(1).Address & ")"))
        'Arr = Application.Index(.Value2, Application.Transpose(x), Evaluate("column(a:h)"))
        If UBound(x) = 0 Then
            Sheets("Fabrication").[A2].Resize(, UBound(Arr)) = Arr
        Else
            Sheets("Fabrication").[A2].Resize(UBound(Arr), UBound(Arr, 2)) = Arr
        End If
        Sheets("Fabrication").Cells(1).CurrentRegion.Columns(1).NumberFormat = "m/d/yyyy"
    End With
End Sub

klin89

Bonjour le Forum,
@klin69, ta solution semble très bien fonctionner : il va juste falloir que je me penche sur les commandes .Parent/.Evaluate que je n'utilise jamais...
Merci beaucoup !

 

[BenHarber]

Bonjour le forum,

Allez j'en remets une couche.

Classiquement pour aller vite on utilise des tableaux VBA :

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim critere$, tablo, ub%, rfesu(), i&, n&, j%, dbrc&
critere = UCase(Replace(Sh.Name, "é", "e")) 'si toute la colonne 8 est en majuscules
With Sheets("Pannes")
    If Sh.Name = .Name Then Exit Sub
    tablo = .ListObjects(1).Range 'matrice, plus rapide
End With
ub = UBound(tablo, 2)
ReDim resu(1 To UBound(tablo), 1 To ub)
For i = 1 To UBound(tablo)
    If tablo(i, 8) = critere Then
        n = n + 1
        For j = 1 To ub: resu(n, j) = tablo(i, j): Next j
    End If
Next i
With Sh.ListObjects(1)
    If Not .DataBodyRange Is Nothing Then dbrc = .DataBodyRange.Rows.Count
    With .Range
        .AutoFilter: .AutoFilter 'affiche tout
        If n > dbrc Then .Rows(2).Resize(n - dbrc).Insert xlDown, xlFormatFromRightOrBelow 'nécessaire si la ligne Total est affichée
        .Cells(2, 1).Resize(n, ub) = resu
        If n < dbrc Then .Rows(n + 2).Resize(dbrc - n).Delete xlUp 'lignes excédentaires
    End With
End Sub

Edit : on voit que seules les lignes excédentaires sont supprimées à la fin.

Sur 224 000 lignes l'activation de la feuille "Fabrication" se fait chez moi en 1,2 seconde, record battu

A+

Bonjour @job75 ,
Merci pour cette version : elle a l'avantage que j'arrive (à peu près) à comprendre tout son déroulé : merci !

 

[BenHarber]

Bonjour à tous,

La p'tiote méthode à ma pomme qui ne modifie ni l'ordre des lignes des données sources ni l'ordre des lignes résultats vis à vis de la source. Le seul tri dans le code ne modifie pas l'ordre relatif des lignes triées (car le tri d'Excel est stable).

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim lsto As ListObject, topD#, ref$, nref&, ncol&, nlig&, n&, i&, j&, xrg1 As Range, xrg2 As Range
   topD = Timer                                                         ' timer début
   Application.ScreenUpdating = False                                   ' on fige l'écran
   If LCase(Sh.Name) = LCase("Pannes") Then Exit Sub                    ' si c'est la feuille "Pannes", on quitte
   ref = Sh.Name                                                        ' la référence à garder
   nref = Sheets("Pannes").ListObjects(1).ListColumns("Service").Index  ' index de la colonne "Service"
   ncol = Sheets("Pannes").ListObjects(1).ListColumns.Count             ' nbre colonnes de la source
   nlig = Sheets("Pannes").ListObjects(1).ListRows.Count + 1            ' nbre lignes de la source
   Columns("a").CurrentRegion.EntireColumn.Clear                        ' effacement du précédent résultat
   [a1].Resize(nlig, ncol).Value2 = Sheets("Pannes").ListObjects(1).Range.Value2          ' copie de la source vers la feuille cible
   [a1].CurrentRegion.Sort Cells(1, ncol), xlAscending, Header:=xlYes, MatchCase:=False   ' tri
   ' première cellule égale à ref
   Set xrg1 = Columns(ncol).Find(what:=ref, LookIn:=xlValues, lookat:=xlWhole, After:=Cells(1, ncol), searchdirection:=xlNext, MatchCase:=False)
   If Not xrg1 Is Nothing Then
      ' dernière cellule égale à ref
      Set xrg2 = Columns(ncol).Find(what:=ref, LookIn:=xlValues, lookat:=xlWhole, After:=Cells(1, ncol), searchdirection:=xlPrevious, MatchCase:=False)
      Range(Cells(xrg2.Row + 1, 1), Cells(nlig + 1, ncol)).Delete shift:=xlShiftUp            ' suppression des lignes après
      If xrg1.Row > 2 Then Range(Cells(2, 1), Cells(xrg1.Row - 1, ncol)).Delete shift:=xlShiftUp   ' suppression des lignes avant
      Set lsto = ActiveSheet.ListObjects.Add(xlSrcRange, [a1].CurrentRegion, , xlYes)              ' plage en tableau structuré
      lsto.Name = ref                                                                              ' nom du TS
      MsgBox "Pour le critère <" & ref & "> : " & Format(lsto.ListRows.Count, "#,##0\ lignes copiées  en ") & _
            Format(Timer - topD, "0.00\ sec.")
   Else
      Range(Cells(1, 1), Cells(Rows.Count - 1, ncol)).Delete shift:=xlShiftUp    ' pas de ligne avec ref -> on efface tout
      MsgBox "Pour le critère <" & ref & "> : aucune ligne copié en " & Format(Timer - topD, "0.00\ sec.")
   End If
End Sub

Bonjour @mapomme , Merci beaucoup pour cette proposition qui convient également très bien 👍

 

[BenHarber]

et pour finir..
sur la TS source, juste un segment pour filtrer directement sur place

et un onglet "Général" (pour remplacer les autres) qui permet de choisir le service, et la Requete se met à jour

Bonjour @vgendron , effectivement les segments sont aussi très puissants. Merci pour ta proposition...même si elle correspond moins à mon besoin actuel, je la garde sous le coude !

 

[BenHarber]

Re
Un autre fichier
Jean marie

Hello Jean-Marie,
Merci pour ta proposition. Je constate qu'elle traite bien le sujet en passant outre la limite max. de 65536 (j'ignore si je vais me retrouver dans cette situation mais je garde ça en mémoire !).