主页 / coding / 问题 / 79016384
Accepted
Tomás Agustín Quinteros Amat
Asked: 2024-09-24 05:44:44 +0800 CST

从循环中排除命名工作表时出现问题

  • 772

在我的工作场所，我有一个用于跟踪施工目的的列数据库。大约有 70 张工作表都基于相同的模板（我将它们称为标准工作表），其中包含每列的数据。每个标准工作表的列宽都与其他标准工作表相同。但是，工作簿中的前三个工作表（标题为“列索引”、“列列表”和“模板”）（我将这些工作表称为非标准工作表）与工作簿中的其他工作表相比具有不同的列宽。

我正在尝试创建一个宏，该宏将调整整个工作簿中每个标准工作表上一系列列的列宽，以防我的项目经理决定他们希望一组列比当前更宽，以便更好地适应页面（这种情况以前发生过，所以我试图自动执行该任务，而不是手动调整 70 多张工作表上的列大小）。我希望这个宏排除非标准工作表。

我查看了几十个按名称排除工作表的示例并尝试使用它们，但我显然做错了。我尝试在整个代码中使用 Select Case、If 语句和 If <...> Not 语句，使用实际工作表名称和 VBA 项目浏览器工作表名称，但都无济于事。我认为最好的方法可能是使用一系列使用整数编号的工作表，从第一个标准工作表开始，但我似乎不知道该怎么做。我也完全有可能通过后面的一行代码意外调用整个工作簿。

我知道我的非标准工作表在 VBA 项目浏览器中的名称如下

“列索引”为“Sheet1” – 此工作表为汇总工作表，汇编了标准工作表中的数据 “列表”为“Sheet2” – 此工作表包含所有标准工作表名称的列表
“模板”为“Sheet 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

3 个回答

  1. Best Answer

    调整列宽（不包括特定工作表）

    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
    • 1

  2. 我想你的意思是

    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

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

    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
    • 0

相关问题