скрытие пустых столбцов на нескольких листах - PullRequest
0 голосов
/ 21 января 2019

Я хочу скрыть пустые столбцы на нескольких листах.Я могу сделать это только на активном листе, но когда я пытаюсь сделать это так, чтобы он применялся ко всем листам с месяцем в имени, он не работает.Это то, что у меня есть до сих пор:

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

Теперь оно также дает мне сообщение «Ошибка метода или члена данных не найдена»

Ответы [ 3 ]

0 голосов
/ 21 января 2019

Я не уверен, что Array может выполнять поиск по шаблону, как вы намеревались.Like - это функция, которую можно использовать, как показано в коде ниже.Надеюсь, что он соответствует вашим потребностям


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 голосов
/ 21 января 2019

Скрыть или удалить пустые столбцы в реальном используемом диапазоне

(Обычно) Стандартный модуль (часто 'Module1')

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
'*******************************************************************************

(Обычно) Листовой модуль (часто 'Sheet1', 'Sheet2 'or ...)

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
'*******************************************************************************
0 голосов
/ 21 января 2019

Класс Worksheet не имеет метода или члена данных с именем col. Вы можете удалить sheet. перед col. Кроме того, в верхней части вашего модуля добавьте Option Explicit; затем, перед запуском кода, откройте меню «Отладка», а затем «Скомпилировать», чтобы быстро обнаружить такие проблемы.

Кроме этого, вам придется проверять каждое имя листа по своим именным фильтрам; К сожалению, коллекция ActiveWorkbook.Sheets не будет магически интерпретировать фильтры в вашем массиве. В конце концов, вы можете пойти по следующим направлениям:

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...