Microsoft 365 Fonction Filtrage

[DavidMM]

Bonjour,

J'ai une liste sur Excel et je voudrai faire un filtrage

je voudrai faire un filtrage ( Chef Reseau 12 et Maintenance Reseau 33)

j obtiens ceci

La question est : Comment pourrai je avoir la ligne juste au dessus pour avoir ceci (la 3e colonne) ?

 

[job75]

Bonjour DavidMM,

Voyez le fichier joint et cette macro dans le code de la feuille "Filtre" :

Private Sub Worksheet_Activate()
Dim n&, crit As Range, i&, j&
Application.ScreenUpdating = False
Columns(1).Delete 'RAZ
[A1] = "Liste"
n = 1
With Sheets("Listes")
    '---liste des critères---
    With .[C1].CurrentRegion
        If .Rows.Count = 1 Then Exit Sub
        Set crit = .Offset(1).Resize(.Rows.Count - 1)
    End With
    '---copie du tableau source---
    With .[A1].CurrentRegion
        For i = 2 To .Rows.Count
            If Application.CountIf(crit, .Cells(i, 1)) Then
                If i > 2 And Application.CountIf(crit, .Cells(i - 1, 1)) = 0 Then
                    n = n + 1
                    .Cells(i - 1, 1).Copy Cells(n, 1) 'copie la ligne précédente
                End If
                n = n + 1
                .Cells(i, 1).Copy Cells(n, 1) 'copie la ligne courante
            End If
        Next
    End With
End With
Columns(1).AutoFit 'ajuste la largeur
End Sub

Elle se déclenche quand on active la feuille.

Elle n'est pas très rapide car les cellules sont copiées une par une pour copier les formats.

Si l'on ne veut pas copier les formats et si le tableau est grand il vaut mieux utiliser des tableaux VBA.

A+

 

[job75]

Si l'on ne veut pas copier les formats et si le tableau est grand il vaut mieux utiliser des tableaux VBA.

Voyez ce fichier (2) et la macro :

Private Sub Worksheet_Activate()
Dim d As Object, i&, tablo, n&
With Sheets("Listes")
    '---liste des critères sans doublon---
    Set d = CreateObject("Scripting.Dictionary")
    d.CompareMode = vbTextCompare 'la casse est ignorée
    With .[C1].CurrentRegion
        For i = 2 To .Rows.Count
            d(.Cells(i, 1).Value) = ""
        Next i
    End With
    '---tableau source et résultats---
    tablo = .[A1].CurrentRegion.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
    For i = 2 To UBound(tablo)
        If d.exists(tablo(i, 1)) Then
            If i > 2 And Not d.exists(tablo(i - 1, 1)) Then
                    n = n + 1
                    tablo(n, 1) = tablo(i - 1, 1)
                End If
                n = n + 1
                tablo(n, 1) = tablo(i, 1)
            End If
    Next i
End With
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] '1ère cellule de destination, à adapter
    If n Then .Resize(n) = tablo
    .Offset(n).Resize(Rows.Count - n - .Row + 1).ClearContents 'RAZ en dessous
End With
Columns(1).AutoFit 'ajuste la largeur
End Sub

Elle est très rapide.

 

[job75]

Pour tester j'ai copié la plage A2:A22 sur 42 000 lignes.

Durées d'exécution chez moi sur Win 11 - Excel 2019 :

- fichier (1) => 90 secondes

- fichier (2) => 0,17 seconde.

 

[DavidMM]

Mes fichiers journaliers sont tres long (2000 lignes à 5000 lignes). Je vais essayer

 

[job75]

J'ai répondu à la question posée au post #1.

Votre fichier n'a plus rien à voir avec le post #1, créez une nouvelle discussion.

Avec des explications claires sur ce que vous voulez obtenir.

A+

 

[DavidMM]

J'ai répondu à la question posée au post #1.

Votre fichier n'a plus rien à voir avec le post #1, créez une nouvelle discussion.

Avec des explications claires sur ce que vous voulez obtenir.

A+

Exact. c'est de ma faute. j'avais oublié l'essentiel des données ! Merci

 

[job75]

La suite est ici :

https://www.excel-downloads.com/threads/filtrage-colonne.20068340/