2
votes

masquage de colonnes vides sur plusieurs feuilles

Je souhaite masquer les colonnes vides sur plusieurs feuilles. Je peux le faire uniquement sur la feuille active, mais lorsque j'essaie de le faire, cela s'applique à toutes les feuilles avec un mois dans le nom, cela ne fonctionne pas. Voici ce que j'ai jusqu'à présent:

Sub CommandButton1_Click()
  Dim col As Range
  Dim sheetsArray As Sheets
  Set sheetsArray = ActiveWorkbook.Sheets(Array("*Jan*", "*Feb*", "*Mar*", "*Apr*", "*May*", "*Jun*", "*Jul*", "*Aug*", "*Sep*", "*Oct*", "*Nov*", "*Dec*"))
  Dim sheet As Worksheet

  Application.ScreenUpdating = False
  For Each sheet In sheetsArray
   sheet.Columns.Hidden = False
        For Each col In sheet.UsedRange.Columns
          col.Hidden = sheet.col.Cells(Rows.Count, 1).End(xlUp).Row = 1
        Next col
  Next sheet

  Application.ScreenUpdating = True
End Sub

Il me donne également maintenant une "Erreur de méthode ou de membre de données non trouvée"


0 commentaires

3 Réponses :


0
votes

La classe Worksheet n'a pas de méthode ou de membre de données nommé col . Vous pouvez supprimer la feuille . devant col . De plus, en haut de votre module, ajoutez Option Explicit ; puis, avant d'exécuter votre code, cliquez sur le menu Déboguer puis sur Compiler afin d'attraper ces problèmes dès le début.

En dehors de cela, vous devrez vérifier chaque nom de feuille par rapport à vos filtres de nom; la collection ActiveWorkbook.Sheets n'interprètera malheureusement pas comme par magie les filtres de votre tableau. En fin de compte, vous pouvez suivre ces lignes:

Option Explicit

Sub CommandButton1_Click()
    Dim sheet As Worksheet
    Dim col As Range
    Dim sheetNameFilters As Variant
    Dim filter As Variant

    sheetNameFilters = Array("*Jan*", "*Feb*", "*Mar*", "*Apr*", "*May*", "*Jun*", "*Jul*", "*Aug*", "*Sep*", "*Oct*", "*Nov*", "*Dec*")

    Application.ScreenUpdating = False

    For Each sheet In ThisWorkbook.Worksheets
        For Each filter In sheetNameFilters
            If sheet.Name Like filter Then
                sheet.Columns.Hidden = False

                For Each col In sheet.UsedRange.Columns
                    col.Hidden = (col.Cells(Rows.Count, 1).End(xlUp).Row = 1)
                Next

                Exit For
            End If
        Next
    Next

    Application.ScreenUpdating = True
End Sub


2 commentaires

Merci - cela a parfaitement fonctionné! Et si je voulais masquer les colonnes en fonction du contenu (vide / non vide) d'une ligne, est-ce que je changerais le col.Hidden = (col.Cells (Rows.Count, 1) .End (xlUp). Ligne = 1) ligne. Ou devez-vous ajouter une instruction If?


@Mari Il vous suffirait de changer la condition par ex. = IsEmpty (col.Cells (someRowIndex, 1) .Value2) someRowIndex est un Long entre 1 et Rows.Count < / code>.



0
votes

Je ne sais pas si Array peut effectuer la recherche par caractères génériques comme vous le souhaitiez. Like est une fonction qui peut être utilisée comme indiqué dans le code ci-dessous. J'espère qu'il répond à vos besoins

Sub HideColumns()
        Dim col As Range
        Dim sheet As Worksheet

        Application.ScreenUpdating = False
        For Each sheet In ThisWorkbook.Worksheets
            'check if worksheet name as month in it
            If sheet.Name Like "*Jan*" Or sheet.Name Like "*Feb*" Or sheet.Name Like "*Mar*" Then 'add for rest of the months
                sheet.Columns.Hidden = False 'make all columns visible
                DoEvents
                'reset the user range
                sheet.UsedRange.Calculate 'if you are using usedrange recommend using this as sometimes usedrange behaves erratically
                For Each col In sheet.UsedRange.Columns
                    'check if there are no entries and first row is also blank - make blank if both conditions are met
                    col.Hidden = IIf(col.Cells(1048576, 1).End(xlUp).Row = 1 And col.Cells(1, 1).Value = "", True, False)
                    DoEvents
                Next col
            End If
        Next sheet
        Application.ScreenUpdating = True
End Sub


0 commentaires

0
votes

Masquer ou supprimer les colonnes vides dans la plage d'utilisation réelle

(généralement) Module standard (souvent 'Module1')

Option Explicit

'*******************************************************************************
Sub CommandButton1_Click()
    ' HIDES columns in Real Used Range.
    HideDeleteColumnsOfRUR
End Sub
'*******************************************************************************
Sub CommandButton2_Click()
    ' Shows (unhides) columns.
    ShowAllColumns
End Sub
'*******************************************************************************
'Sub CommandButton3_Click()
'    ' DELETES columns in Real Used Range.
'    HideDeleteColumnsOfRUR True ' (or probably any number different than 0.)
'End Sub
'*******************************************************************************

(généralement) Module de feuille (souvent 'Sheet1') ',' Sheet2 'ou ...)

Option Explicit

'*******************************************************************************
' Purpose:    Hides or deletes all blank columns in the Real Used Range
'             of worksheets specified by a name pattern list.
' Remarks:    The Real Used Range is calculated by using the Find method which
'             avoids any possible 'errors' occuring when using the UsedRange
'             property.
'*******************************************************************************
Sub HideDeleteColumnsOfRUR(Optional HideFalse_DeleteTrue As Boolean = False)

    ' Worksheet Name Pattern List
    Const cSheets As String = "*Jan*,*Feb*,*Mar*,*Apr*,*May*,*Jun*,*Jul*," _
            & "*Aug*,*Sep*,*Oct*,*Nov*,*Dec*"
    ' If a cell contains a formula that evaluates to "" and if cLookIn is
    ' equal to xlValues (-4163), it will not be found (Not blank).
    Const cLookIn As Variant = -4123 ' -4163 Value, -4123 Formula, -4144 Comment

    Dim ws As Worksheet       ' (Current) Worksheet
    Dim RUR As Range          ' (Current) Real Used Range
    Dim rngU As Range         ' (Current) Union Range
    Dim vntSheets As Variant  ' Sheet Array
    Dim i As Long             ' Sheet Array Row Counter
    Dim j As Long             ' Used Range Column Counter

    Application.ScreenUpdating = False

    On Error GoTo ProcedureExit ' Enable ScreenUpdating if error occurs.

    ' Write Worksheet Name Pattern List to Sheet Array.
    vntSheets = Split(cSheets, ",")

    ' Remove possible occurrences of leading and trailing spaces in
    ' Sheet Array.
    'For i = 1 To UBound(vntSheets): vntSheets(i) = Trim(vntSheets(i)): Next

    For Each ws In ThisWorkbook.Worksheets ' Loop through worksheets.
        For i = 0 To UBound(vntSheets) ' Loop through Worksheet Name Patterns.
            If ws.Name Like vntSheets(i) Then ' Worksheet Name Pattern found.
                ' Unhide all columns, calculate Real Used Range and Union Range.
                GoSub RangeAccumulator
                Exit For ' Stop checking for (Current) Worksheet Name Patterns.
            End If
        Next
    Next

ProcedureExit:
    Application.ScreenUpdating = True

Exit Sub

RangeAccumulator:
    With ws
        ' Unhide all columns in (Current) Worksheet.
        .Columns.Hidden = False
        ' Calculate Real Used Range.
        If Not .Cells.Find("*", .Cells(.Rows.Count, .Columns _
                .Count), -4123, , 1) Is Nothing Then ' Is not empty sheet.
            Set RUR = .Range(.Cells(.Cells.Find("*", .Cells(.Rows.Count, _
                    .Columns.Count)).Row, .Cells.Find("*", .Cells(.Rows.Count, _
                    .Columns.Count), , , 2).Column), .Cells(.Cells _
                    .Find("*", , , , 1, 2).Row, .Cells.Find("*", , , , 2, 2) _
                    .Column))
          Else ' Is empty sheet.
            'MsgBox "Worksheet '" & ws.Name & "' is an empty sheet."
            Return
        End If
    End With
    ' Accumulate Union Range using only Real Used Range's first-row cells (1).
    With RUR
        For j = 1 To .Columns.Count
            If .Columns(j).Find("*", , cLookIn, , 2, 2) Is Nothing Then
                If Not rngU Is Nothing Then
                    Set rngU = Union(rngU, .Cells(1, j))
                  Else
                    Set rngU = .Cells(1, j)
                End If
            End If
        Next
    End With
    ' Hide or Delete Union Range's columns.
    If Not rngU Is Nothing Then
        With rngU.EntireColumn
            If Not HideFalse_DeleteTrue Then
                .Hidden = True
              Else
                .Delete
            End If
        End With
        Set rngU = Nothing
    End If
Return

End Sub
'*******************************************************************************

'*******************************************************************************
' Purpose:    Shows (unhides) all blank columns in worksheets specified by
'             a name pattern list.
'*******************************************************************************
Sub ShowAllColumns()

    ' Worksheet Name Pattern List
    Const cSheets As String = "*Jan*,*Feb*,*Mar*,*Apr*,*May*,*Jun*,*Jul*," _
            & "*Aug*,*Sep*,*Oct*,*Nov*,*Dec*"

    Dim ws As Worksheet       ' (Current) Worksheet
    Dim vntSheets As Variant  ' Sheet Array
    Dim i As Long             ' Sheet Array Row Counter

    Application.ScreenUpdating = False

    On Error GoTo ProcedureExit ' Enable ScreenUpdating if error occurs.

    ' Write Worksheet Name Pattern List to Sheet Array.
    vntSheets = Split(cSheets, ",")

    ' Remove possible occurrences of leading and trailing spaces in
    ' Sheet Array.
    'For i = 1 To UBound(vntSheets): vntSheets(i) = Trim(vntSheets(i)): Next

    For Each ws In ThisWorkbook.Worksheets ' Loop through worksheets.
        For i = 0 To UBound(vntSheets) ' Loop through Worksheet Name Patterns.
            If ws.Name Like vntSheets(i) Then ' Worksheet Name Pattern found.
                ' Unhide all columns in (Current) Worksheet.
                ws.Columns.Hidden = False
                Exit For ' Stop checking for (Current) Worksheet Name Patterns.
            End If
        Next
    Next

ProcedureExit:
    Application.ScreenUpdating = True

End Sub
'*******************************************************************************

0 commentaires