XL 2019 masquer colonne si vide

  • Initiateur de la discussion Initiateur de la discussion tanmyirt
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

T

tanmyirt

Guest
Bonjour,
J'ai besoin de votre aide. je veux masquer l'ensemble des colonnes vide a partir de colonne "entrée" jusqu'à "état de stock" et ainsi de suite pour les autres tableau. merci
VB:
Sub Masquer()
Dim h&, r As Range
Set r = Sheets("stock").[E:I,AA:AE] 'zones à adapter
h = r(1).CurrentRegion.Rows.Count - 4
If h < 1 Then Exit Sub
For Each r In r
    r.EntireColumn.Hidden = Application.CountA(r(2).Resize(h)) = 0
Next
End Sub
 

Pièces jointes

Solution
sans modifier le code VBA, tu peux cliquer sur tes 2 boutons :
ça fera ce qu'il faut ; voici le code VBA du fichier du post #4 :

VB:
Option Explicit: Option Compare Text

Dim dlg&

Private Sub Job(i As Byte)
  Dim j%, k%, n%: k = 11 * i + 5
  For j = 0 To 4
    n = k + j: Columns(n).Hidden = (Application.Sum(Cells(3, n).Resize(dlg - 2)) = 0)
  Next j
End Sub

Sub Masquer()
  Dim i As Byte: Application.ScreenUpdating = 0: Worksheets("stock").Select
  dlg = Cells(Rows.Count, 4).End(3).Row: For i = 0 To 4: Job i: Next i
End Sub

Sub Afficher_tout()
  Worksheets("stock").Columns.Hidden = 0
End Sub
j'ai laissé le Option Compare Text qui était déjà présent, mais en fait,
il ne sert pas ; tu peux donc l'enlever, et laisser...
Bonsoir,
A tester:
VB:
Option Compare Text
Sub Masquer()
Dim Scope()
Scope = Array("stock initial", "entrees", "sorties", "stock", "mini", "état de stock")
    nrows = ActiveSheet.UsedRange.Rows.Count
    For Each Column In Columns
        If IsInArray(Column.Cells(1), Scope) Then
            If WorksheetFunction.CountA(Column.Cells(3).Resize(nrows - 2)) = 0 Then Column.Hidden = True
        End If
    Next
End Sub
Function IsInArray(Objet As String, Crit())
    IsInArray = True
        For Each Elem In Crit
            If Trim(Objet) = Elem Then Exit Function
        Next
    IsInArray = False
End Function
Sub Afficher_tout()
Sheets("stock").Columns.Hidden = False
End Sub
 
Bonsoir,
A tester:
VB:
Option Compare Text
Sub Masquer()
Dim Scope()
Scope = Array("stock initial", "entrees", "sorties", "stock", "mini", "état de stock")
    nrows = ActiveSheet.UsedRange.Rows.Count
    For Each Column In Columns
        If IsInArray(Column.Cells(1), Scope) Then
            If WorksheetFunction.CountA(Column.Cells(3).Resize(nrows - 2)) = 0 Then Column.Hidden = True
        End If
    Next
End Sub
Function IsInArray(Objet As String, Crit())
    IsInArray = True
        For Each Elem In Crit
            If Trim(Objet) = Elem Then Exit Function
        Next
    IsInArray = False
End Function
Sub Afficher_tout()
Sheets("stock").Columns.Hidden = False
End Sub
merci pour votre réponse ca marche bien. mais avec une fonction dans les cellules vide ca marche pas
merci encore une fois
 

Pièces jointes

Dernière modification par un modérateur:
Bonjour @tanmyirt, fanch55,

ton fichier en retour ; je te laisse faire les tests. 🙂

remarque : la macro ne prend pas en compte ta ligne 2 masquée,
car elle contient des #REF! ; à toi de voir si tu préfères supprimer
cette ligne, ou si tu veux la garder ; dans ce 2ème cas, tu dois
faire ce qu'il faut pour qu'il n'y aie plus de #REF! ; dans les 2 cas,
il faudra adapter la macro en conséquence.

si tu as besoin d'une adaptation, n'hésite pas à demander.
à te lire pour avoir ton avis. 😉


soan
 

Pièces jointes

sans modifier le code VBA, tu peux cliquer sur tes 2 boutons :
ça fera ce qu'il faut ; voici le code VBA du fichier du post #4 :

VB:
Option Explicit: Option Compare Text

Dim dlg&

Private Sub Job(i As Byte)
  Dim j%, k%, n%: k = 11 * i + 5
  For j = 0 To 4
    n = k + j: Columns(n).Hidden = (Application.Sum(Cells(3, n).Resize(dlg - 2)) = 0)
  Next j
End Sub

Sub Masquer()
  Dim i As Byte: Application.ScreenUpdating = 0: Worksheets("stock").Select
  dlg = Cells(Rows.Count, 4).End(3).Row: For i = 0 To 4: Job i: Next i
End Sub

Sub Afficher_tout()
  Worksheets("stock").Columns.Hidden = 0
End Sub
j'ai laissé le Option Compare Text qui était déjà présent, mais en fait,
il ne sert pas ; tu peux donc l'enlever, et laisser Option Explicit.


soan
 
@tanmyirt

Lis d'abord mes 2 posts précédents.

si tu veux que la ligne 2 soit prise en compte, tu dois changer 2 nombres,
pour avoir ceci, dans la sub privée Job() :

Columns(n).Hidden = (Application.Sum(Cells(2, n).Resize(dlg - 1)) = 0)

mais la ligne 2 ne doit pas contenir de #REF!
sinon, la macro ne marchera pas ! 😕 🙄


soan
 
sans modifier le code VBA, tu peux cliquer sur tes 2 boutons :
ça fera ce qu'il faut ; voici le code VBA du fichier du post #4 :

VB:
Option Explicit: Option Compare Text

Dim dlg&

Private Sub Job(i As Byte)
  Dim j%, k%, n%: k = 11 * i + 5
  For j = 0 To 4
    n = k + j: Columns(n).Hidden = (Application.Sum(Cells(3, n).Resize(dlg - 2)) = 0)
  Next j
End Sub

Sub Masquer()
  Dim i As Byte: Application.ScreenUpdating = 0: Worksheets("stock").Select
  dlg = Cells(Rows.Count, 4).End(3).Row: For i = 0 To 4: Job i: Next i
End Sub

Sub Afficher_tout()
  Worksheets("stock").Columns.Hidden = 0
End Sub
j'ai laissé le Option Compare Text qui était déjà présent, mais en fait,
il ne sert pas ; tu peux donc l'enlever, et laisser Option Explicit.


soan
merci infiniment pour votre aide
 
Bonjour @tanmyirt, fanch55,

ton fichier en retour ; je te laisse faire les tests. 🙂

remarque : la macro ne prend pas en compte ta ligne 2 masquée,
car elle contient des #REF! ; à toi de voir si tu préfères supprimer
cette ligne, ou si tu veux la garder ; dans ce 2ème cas, tu dois
faire ce qu'il faut pour qu'il n'y aie plus de #REF! ; dans les 2 cas,
il faudra adapter la macro en conséquence.

si tu as besoin d'une adaptation, n'hésite pas à demander.
à te lire pour avoir ton avis. 😉


soan
merci infiniment pour vos efforts
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
3
Affichages
546
Retour