在多张纸上隐藏空白列

时间:2019-01-21 03:47:23

标签: excel vba

我想隐藏多张纸上的空白列。我可以仅在活动工作表上执行此操作,但是当我尝试进行创建时,将其应用到名称为一个月的所有工作表上将不起作用。这是我到目前为止的内容:

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 :(得分:0)

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

答案 1 :(得分:0)

我不确定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

答案 2 :(得分:0)

隐藏或删除实际使用范围内的空白列

(通常)标准模块(通常为“模块1”)

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”或...)

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