Masquer Colonne si aucune "valeur" n'est reprise dans cette meme colonne

Bullrot

XLDnaute Junior
Bonjour,

Je vous solicite pour voir si c'est faisable de "reduire" la taille du code?

J'ai un simple annuaire téléphonique avec le qui j'aimerais qu'il s'adapte automaiquement si il y une cellule avec du texte dedans

Si dans la colonne "I3" à Fin de "I" il y a aucune valeur, alors masque la colonne.

Etc pour chacune des colonnes du tableau

Merci

Bullrot

VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Range("I3:I50").value = 0 Then
        Columns("I").FullyColumn.Hidden = True
        Else
        Columns("I").FullyColumn.Hidden = False
    End If
    If Range("J3:J1000").value = "" Then
        Columns("J").FullyColumn.Hidden = True
        Else
        Columns("J").FullyColumn.Hidden = False
    End If
    If Range("K3:K1000").value = "" Then
        Columns("K").FullyColumn.Hidden = True
        Else
        Columns("K").FullyColumn.Hidden = False
    End If
    If Range("L3:L1000").value = "" Then
        Columns("L").FullyColumn.Hidden = True
        Else
        Columns("L").FullyColumn.Hidden = False
    End If
        If Range("M3:M1000").value = "" Then
        Columns("M").FullyColumn.Hidden = True
        Else
        Columns("M").FullyColumn.Hidden = False
    End If
        If Range("N3:M1000").value = "" Then
        Columns("N").FullyColumn.Hidden = True
        Else
        Columns("N").FullyColumn.Hidden = False
    End If
        If Range("O3:O1000").value = "" Then
        Columns("O").FullyColumn.Hidden = True
        Else
        Columns("O").FullyColumn.Hidden = False
    End If
        If Range("P3:P1000").value = "" Then
        Columns("P").FullyColumn.Hidden = True
        Else
        Columns("P").FullyColumn.Hidden = False
    End If
        If Range("Q3:Q1000").value = "" Then
        Columns("Q").FullyColumn.Hidden = True
        Else
        Columns("Q").FullyColumn.Hidden = False
    End If
End Sub
 

Pièces jointes

  • Classeur1.xlsx
    11.6 KB · Affichages: 14

vgendron

XLDnaute Barbatruc
Hello

Essaie avec ce code à mettre dans un module standard
VB:
Sub MaskOrShow()
fin = Range("A" & Rows.Count).End(xlUp).Row
For col = 9 To 17
    Columns(col).EntireColumn.Hidden = Not (WorksheetFunction.CountBlank(Range(Cells(2, col), Cells(fin, col))) <> (fin - 1))
Next col
End Sub
 

job75

XLDnaute Barbatruc
Bonjour Bullrot, vgendron,
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim col%
For col = 9 To 17
    Columns(col).Hidden = Application.CountA(Range("A3:A1000").Offset(, col - 1)) = 0
Next
End Sub
Je ne connais pas la propriété FullyColumn, où l'avez-vous pêchée ???

A+
 

job75

XLDnaute Barbatruc
Je n'avais pas ouvert votre fichier, il y a des textes vides "" dans les colonnes, alors utilisez :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim col%
For col = 9 To 17
    Columns(col).Hidden = Evaluate("SUM(N(" & Range("A2:A1000").Offset(, col - 1).Address & "<>""""))") = 0
Next
End Sub
Sur le fichier il faut compter à partir de la ligne 2.
 

job75

XLDnaute Barbatruc
Avez-vous testé la solution (matricielle) avec SUM (SOMME) de mon post #5 ?

Autre solution avec la fonction OR (OU) :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim col%
For col = 9 To 17
    Columns(col).Hidden = Evaluate("NOT(OR(" & Range("A2:A1000").Offset(, col - 1).Address & "<>""""))")
Next
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 949
Membres
101 851
dernier inscrit
vaiata