Microsoft 365 MFC : si + de 3 cellules non vides sur la ligne

[MarionP85]

Bonjour,

Je ne trouve pas comment faire ma MFC sur les lignes qui comportent + de 3 cellules non vides sur cette ligne (je ne sais pas si ca change quelque chose mais c'est sur un tdc ; si jamais ca existe sinon une formule/macro ou quelque chose qui pourrait supprimer les lignes de mon tableau ou il y a - de 4 cellules non vides)

Merci à vous
Bonne journée
Marion

 

[MarionP85]

Bonjour et encore merci à vous

Laurent78 peux tu m'expliquer ce que tu as fait, je suis assez nulle sur le sujet et je ne comprends pas très bien ?

Yeahou du coup si j'ai un nombre de colonnes qui varient, je dois changer quoi ? Car la macro fonctionne très bien lorsque j'ouvre ton fichier pour la première fois mais ensuite lorsque je rajoute des données elle ne fonctionne plus

Bonne journée à vous

 

[Bernard_XLD]

tu ajoutes quoi comme données, si ce sont des colonnes d'analyse, il faut adapter le code ici
4 colonnes à enlever de l'analyse, si tu en ajoutes

Nb_Col = Feuil1.Range("IV4").End(xlToLeft).Column - 4 'définition du Nbr de colonne du tableau, à mettre à jour si ajout de colonne avec valeur en ligne 4

mais je vois que tes deux colonnes d'analyse géneront si tu augmentes le nombre de mois dans ton TCD
tu devrais les décaler
je regarde pour ne plus avoir à vérifier le nombre de mois pour la macro

 

[Bernard_XLD]

Bonjour

Voila le code modifié, tu peux ajouter maintenant les colonnes ou les lignes d'analyse que tu veux, avant ou après ton TCD, tant que tu ne modifies pas la structure même du TCD (en ajoutant des sous totaux par exemple), cela fonctionnera.

Cordialement

Sub Traitement_TCD()
    Dim Compteur As Integer, Seuil_NV As Byte, Nb_Col As Byte 'déclaration des variables
    With Application
        .ScreenUpdating = False 'désactivation de l'affichage pour le temps de traitement
        .Calculation = xlCalculationManual 'désactivation du calcul automatique pour le temps de traitement
    End With
    On Error GoTo Gere_Erreurs 'routine de gestion des erreurs pour réactiver le calcul automatique si erreur
    Seuil_NV = Feuil1.Range("N2").Value 'définition de la valeur de seuil
    With Feuil1.PivotTables("Producteurs NC")
        Nb_Col = .TableRange1.Columns.Count - 2 'définition du Nbr de colonne du tableau à analyser, nbr - colonnes de libellés et de total
        For Compteur = .TableRange1.Row + .TableRange1.Rows.Count - 2 To .TableRange1.Row + 2 Step -1 'boucle sur les lignes du tableau
            If Test_Vides(Feuil1.Range(Cells(Compteur, .TableRange1.Column).Address & ":" & Cells(Compteur, .TableRange1.Column + Nb_Col).Address).SpecialCells(xlCellTypeBlanks)) Then 'appel de la fonction test existence cellule vide
                If Nb_Col - Feuil1.Range(Cells(Compteur, .TableRange1.Column).Address & ":" & Cells(Compteur, .TableRange1.Column + Nb_Col).Address).SpecialCells(xlCellTypeBlanks).Count < Seuil_NV Then 'teste le nbr de cellules pleines si < au seuil
                    .PivotFields("numéro").PivotItems(Feuil1.Cells(Compteur, .TableRange1.Column).Value).Visible = False 'sur test positif, désactive le numéro dans le TCD
                End If
            End If
        Next Compteur
    End With
Gere_Erreurs:
    With Application
        .ScreenUpdating = True 'activation de l'affichage
        .Calculation = xlCalculationAutomatic 'activation du calcul automatique
    End With
End Sub
Function Test_Vides(Plage_Test As Range)
    Dim Nb_Temp As Integer
    On Error GoTo Gere_Erreurs 'sur erreur, renvoie sur Gere_Erreurs
    Nb_Temp = Plage_Test.Count 'compte les cellules vides parmi la ligne compteur du TCD, renvoie une erreur si aucune et sort de la function qui reste à false
    Test_Vides = True 'si pas d'erreur, passe la Function Test_Vides à True
Gere_Erreurs:
End Function

 

[Bernard_XLD]

et si cela te convient, modifies la solution

Cordialement, @+

 

[MarionP85]

C'est top tout fonctionne niquel ! Encore merci d'avoir prit de votre temps pour moi
Cordialement,

 

[Bernard_XLD]

j'ai fait cela aussi, une modification qui re affiche tous les éléments avant d'appliquer le filtre, pratique pour passer de 2 à 3 éléments, ou si des éléments sont modifiés dans les données et remplissent du coup les conditions.
je mets le code, ça peut servir.

Cordialement, @+

Sub Traitement_TCD()
    Dim Compteur As Integer, Seuil_NV As Byte, Nb_Col As Byte 'déclaration des variables
    With Application
        .ScreenUpdating = False 'désactivation de l'affichage pour le temps de traitement
        .Calculation = xlCalculationManual 'désactivation du calcul automatique pour le temps de traitement
    End With
    On Error GoTo Gere_Erreurs 'routine de gestion des erreurs pour réactiver le calcul automatique si erreur
    Seuil_NV = Feuil1.Range("N2").Value 'définition de la valeur de seuil
    With Feuil1.PivotTables("Producteurs NC")
        For Compteur = 1 To .PivotFields("numéro").PivotItems.Count 'boucle pour réafficher tous les éléments
            .PivotFields("numéro").PivotItems(Compteur).Visible = True
        Next Compteur
        With .TableRange1
            Nb_Col = .Columns.Count - 2 'définition du Nbr de colonne du tableau à analyser, nbr - colonnes de libellés et de total
            For Compteur = .Row + .Rows.Count - 2 To .Row + 2 Step -1 'boucle sur les lignes de données du tableau de la fin au début
                If Test_Vides(Feuil1.Range(Cells(Compteur, .Column).Address & ":" & Cells(Compteur, .Column + Nb_Col).Address).SpecialCells(xlCellTypeBlanks)) Then 'appel de la fonction test existence cellule vide
                    If Nb_Col - Feuil1.Range(Cells(Compteur, .Column).Address & ":" & Cells(Compteur, .Column + Nb_Col).Address).SpecialCells(xlCellTypeBlanks).Count < Seuil_NV Then 'teste le nbr de cellules pleines si < au seuil
                        Feuil1.PivotTables("Producteurs NC").PivotFields("numéro").PivotItems(Feuil1.Cells(Compteur, .Column).Value).Visible = False 'sur test positif, désactive le numéro dans le TCD
                    End If
                End If
            Next Compteur
        End With
    End With
Gere_Erreurs:
    With Application
        .ScreenUpdating = True 'activation de l'affichage
        .Calculation = xlCalculationAutomatic 'activation du calcul automatique
    End With
End Sub
Function Test_Vides(Plage_Test As Range)
    Dim Nb_Temp As Integer
    On Error GoTo Gere_Erreurs 'sur erreur, renvoie sur Gere_Erreurs
    Nb_Temp = Plage_Test.Count 'compte les cellules vides parmi la ligne compteur du TCD, renvoie une erreur si aucune et sort de la function qui reste à false
    Test_Vides = True 'si pas d'erreur, passe la Function Test_Vides à True
Gere_Erreurs:
End Function