Masquage de ligne automatique si la cellule ne contient pas un mot

Bonjour à tous,

J'ai un soucis concernant des filtres automatiques. J'espère que quelqu'un pourra m'éclairer (je suis novice en VBA)

Dans le fichier test ci-joint, je souhaiterais afficher uniquement les lignes qui contiennent l'équivalent de ma cellule A1 (en colonne B) et qui comporte "OUI" en colonne K. Le but étant de modifier uniquement la cellule A1; tout le reste doit se faire en automatique

Je vous remercie beaucoup de votre aide.

Cordialement

Navillus

Bonjour,

Pourquoi ne mettez vous pas simplement un filtre automatique sur la ligne 2 entre B2 et K2
Ensuite vous filtrez la colonne K pour les Oui et la colonne B pour le chiffre désiré

Cordialement

Bonjour,

Il s'agit d'un tableau simplifié que je vous ai partagé. mon but est de verrouiller toutes les cellules de la page et de laisser accès à mes collaborateurs uniquement la cellule A1. (la cellule A1 sera remplacée par le nom de mes collègues dans le tableau final).

C'est pour cette raison que je souhaite qu'ils mettent simplement leur nom (liste déroulante) et que le reste se fasse tout seul.

Cordialement

Navillus

En complément d'information, voici le code VBA que j'ai entré. Mais il ne fonctionne pas.

Pourriez vous me dire quelle erreur j'ai pu faire dans le code ?

Sub aa()

Dim DerCol As Integer, i As Integer

Application.ScreenUpdating = False

Call Tout_montrer

DerCol = Cells(1, Columns.Count).End(xlToLeft).Column

For i = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1

If WorksheetFunction.CountIf(Range(Cells(i, 3), Cells(i, DerCol)), "OUI") + WorksheetFunction.CountIf(Range(Cells(i, 3), Cells(i, DerCol)), Range("A1").Value) <= 0 Then

Rows(i).EntireRow.Hidden = True

End If

Next

ActiveWindow.ScrollColumn = 1

ActiveWindow.ScrollRow = 1

End Sub

Sub Tout_montrer()

Cells.EntireRow.Hidden = False

End Sub

Bien à vous

Navillus

Re,

Sur base de votre fichier, faites ceci :

1. Click droite sur l'onglet Sheet1
2. choisir l'option "Visualiser le code"
3. Coller le code ci dessous dans la fenêtre

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("A1")) Is Nothing Then
    Call aa
End If
End Sub

4. Allez dans l'éditeur VBA
5. remplacez les deux codes "aa" et "Tout_montrer" par celui ci-dessous

Sub aa()
Dim DerCol As Integer, i As Integer

Application.ScreenUpdating = False
Cells.EntireRow.Hidden = False
DerCol = Cells(2, Columns.Count).End(xlToLeft).Column
For i = Range("B" & Rows.Count).End(xlUp).Row To 3 Step -1
    If Cells(i, 2).Value <> Range("A1").Value Or UCase(Cells(i, 11).Value) <> "OUI" Then
        Rows(i).EntireRow.Hidden = True
    End If
Next i
Application.ScreenUpdating = True
End Sub

Il vous reste à choisir dans la liste en cellule A1

Cordialement

Je vous remercie, le code fonctionne.

C'est extrêmement à charger par contre. C'est certainement dû aux faibles performances de mon PC.

Merci pour votre aide précieuse!

Sincèrement

Navillus

Extrêmement long à charger*

Extrêmement long à charger*

En utilisation de boucle oui.

Vous avez combien de lignes à traiter ?

Edit : sinon vous devriez gagner en rapidité en remplaçant le code Sub aa, par celui ci-dessous

Sub aa()
Dim DerCol As Integer, Derlig As Integer

Application.ScreenUpdating = False
With ActiveSheet
    DerCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
    Derlig = .UsedRange.Rows.Count

    If .AutoFilterMode = False Then
        .Range("B2:K" & DerCol).AutoFilter
    End If

    With .Range("$B$2:$K$" & Derlig)
        If ActiveSheet.Range("A1") <> "" Then
            .AutoFilter Field:=10, Criteria1:="OUI"
            .AutoFilter Field:=1, Criteria1:=Range("A1")
        Else:
            On Error Resume Next
            .ShowAllData
        End If
    End With
End With
Application.ScreenUpdating = True
End Sub

Cordialement