我正在跟踪用于建设目的的专栏。
大约有 70 张基于同一模板的工作表(我将其称为标准工作表),其中包含每列的数据。每个标准表都有相同的列宽。
工作簿中的前三张工作表,标题为“列索引”、“列列表”和“模板”(我将这些工作表称为非标准工作表),与工作簿中的其他工作表相比,具有不同的列宽.
我正在尝试创建一个宏,该宏将调整整个工作簿中每个标准工作表上一系列列的列宽,以防我的项目经理希望一组列比当前更宽以更好地适应在一页上。
我正在尝试自动化该任务,而不是手动调整 70 多张纸上的列大小。我想排除非标准板材。
我浏览了数十个示例(按名称排除工作表)并尝试使用它们。
我在整个代码中尝试了 Select Case、If 语句和 If <...> Not 语句,使用实际工作表名称和 VBA 项目浏览器工作表名称。
最好的方法可能是使用一系列使用整数编号的工作表,从第一个标准表开始,但我不知道该怎么做。我也有可能不小心通过后面的代码行调用了整个工作簿。
我的非标准工作表在 VBA 项目浏览器中的命名如下。
“列索引”是“Sheet1” – 该表是汇总表,编译了标准表中的数据
“列列表”是“Sheet2” – 该工作表包含所有标准工作表名称的列表
“模板”是“表 4”——此表是标准表的模板
我删除并创建了工作表,因此第一个标准表的实际名称在 VBA 项目浏览器中为“Sheet5”,最后一个标准表在 VBA 项目浏览器中为“Sheet79”,以防万一你们尝试使用一系列数字。
Sub ChangeChosenColumnSizesToMatchLargest()
Dim ws As Worksheet
Dim c As Integer
Dim m As Variant
Dim ColumnWidth As Variant
For Each ws In ActiveWorkbook.Worksheets 'For all sheets
If ws.Name <> "Column Index" And "Column List" And "Template" Then 'Except Non-Standard
For c = 7 To 10 'For columns G through J
m = 0 'Reset the column width
For Each w In Worksheets 'Check all Standard Sheets
If w.Columns(c).ColumnWidth > m Then 'If a column is bigger than m
m = w.Columns(c).ColumnWidth 'Reset it
End If
Next w 'Check next Standard Sheet
For Each w In Worksheets 'Check all Standard Sheets
If w.Columns(c).ColumnWidth = 0 Then 'Once a column is reset
w.Columns(c).ColumnWidth = m 'Change width to new width
End If
Next w 'Check next Standard Sheet
Next c 'Check next column
End If
Next ws 'Check next Standard Sheet
End Sub
Sub ResizeColumnWidthsToLargest()
' Define constants.
Const ADJUST_COLUMNS As String = "G:J"
Dim SHEETS_TO_EXCLUDE() As Variant:
SHEETS_TO_EXCLUDE = Array("Column Index", "Column List", "Template")
' Reference the workbook.
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Create/reference a new instance of the VBA collection
' to hold the required worksheet objects collected in the 1st loop
' to be utilized in the 2nd loop.
Dim coll As Collection: Set coll = New Collection
' Declare additional variables.
Dim ws As Worksheet, crg As Range, MaxColumnWidth As Double
' Determine the largest column width.
For Each ws In wb.Worksheets
If IsError(Application.Match(ws.Name, SHEETS_TO_EXCLUDE, 0)) Then
For Each crg In ws.Columns(ADJUST_COLUMNS).Columns
If crg.ColumnWidth > MaxColumnWidth Then
MaxColumnWidth = crg.ColumnWidth
End If
Next crg
coll.Add ws
End If
Next ws
' Exit if no worksheet found.
If coll.Count = 0 Then Exit Sub
' Resize the column widths to the largest column width.
For Each ws In coll
ws.Columns(ADJUST_COLUMNS).ColumnWidth = MaxColumnWidth
Next ws
' Inform.
MsgBox "Column widths adjusted to largest.", vbInformation
End Sub
我想你的意思是
If ws.Name <> "Column Index" Or ws.Name <> "Column Index" Or ws.Name <> "Column Index" Then
而不是
If ws.Name <> "Column Index" And "Column List" And "Template"
通常最好将代码分解为更简单的任务。
Rem Defining a dedicated function to determine is a sheet is a standard sheet or not will make it easier to update your code later on
Function IsStandardSheet(ws As Worksheet) As Boolean
IsStandardSheet = Not (ws.Name = "Column Index" Or ws.Name = "Column List" Or ws.Name = "Template")
End Function
Rem Creating a function to determine the largest ColumnWidth makes it easier to test the logic
Function FindTheLargestColumnWidth(ColumnIndex As Variant) As Long ' I use Variant to add support for column letter or index
Dim ws As Worksheet
Dim ColumnWidth As Long
For Each ws In ActiveWorkbook.Worksheets
If IsStandardSheet(ws) Then
If ws.Columns(ColumnIndex).ColumnWidth > ColumnWidth Then ColumnWidth = ws.Columns(ColumnIndex).ColumnWidth
End If
Next
FindTheLargestColumnWidth = ColumnWidth
End Function
Sub ChangeChosenColumnSizesToMatchLargest(ws As Worksheet)
Dim ws As Worksheet
Dim ColumnWidth As Variant
Dim ColumnIndex As Long
For Each ws In ActiveWorkbook.Worksheets 'For all sheets
If IsStandardSheet(ws) Then 'Except Non-Standard
ColumnWidth = FindTheLargestColumnWidth(ColumnIndex)
For ColumnIndex = 7 To 10 'For columns G through J
ws.Columns(ColumnIndex).ColumnWidth = ColumnWidth
Next
End If
Next ws 'Check next Standard Sheet
End Sub