从循环中排除命名工作表

问题描述 投票:0回答:3

我正在跟踪用于建设目的的专栏。
大约有 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
excel vba loops for-loop if-statement
3个回答
1
投票

调整列宽度(不包括特定工作表)

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

0
投票

我想你的意思是

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"

0
投票

通常最好将代码分解为更简单的任务。

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
© www.soinside.com 2019 - 2024. All rights reserved.