我想隐藏多张纸上的空白列。我可以仅在活动工作表上执行此操作,但是当我尝试进行创建时,将其应用到名称为一个月的所有工作表上将不起作用。这是我到目前为止的内容:
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
它现在也给我一个“找不到方法或数据成员的错误”
答案 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)
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
'*******************************************************************************
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
'*******************************************************************************