请求修改VBA代码以批量格式化多工作表指定表格列

需求说明 #

我在某工作表的B、C、D、E列分别记录了工作表名称、表格/区域名称、列名及格式要求，希望通过VBA宏遍历该列表，为对应工作表的指定表格/区域列或全部列应用格式化。

配置表格 #

修改后的完整VBA代码 #

Option Explicit

Sub FormatMultipleRanges()
    Dim configSht As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim targetSht As Worksheet
    Dim targetRange As Range
    Dim colNames() As String
    Dim colName As Variant
    Dim targetCol As Range
    
    ' 设置配置表（假设是当前激活工作表，可根据实际修改）
    Set configSht = ThisWorkbook.ActiveSheet
    lastRow = configSht.Cells(configSht.Rows.Count, "B").End(xlUp).Row
    
    ' 遍历配置表的每一行（从第2行开始，跳过表头）
    For i = 2 To lastRow
        ' 检查目标工作表是否存在
        On Error Resume Next
        Set targetSht = ThisWorkbook.Worksheets(configSht.Cells(i, "B").Value)
        On Error GoTo 0
        If targetSht Is Nothing Then
            MsgBox "工作表" & configSht.Cells(i, "B").Value & "不存在，跳过该行", vbExclamation
            Set targetSht = Nothing
            GoTo NextRow
        End If
        
        ' 检查目标表格/区域是否存在
        On Error Resume Next
        Set targetRange = targetSht.Range(configSht.Cells(i, "C").Value)
        On Error GoTo 0
        If targetRange Is Nothing Then
            MsgBox "工作表" & targetSht.Name & "中的区域" & configSht.Cells(i, "C").Value & "不存在，跳过该行", vbExclamation
            Set targetRange = Nothing
            Set targetSht = Nothing
            GoTo NextRow
        End If
        
        ' 处理列名配置
        If configSht.Cells(i, "D").Value = "All Columns" Then
            ' 应用格式到整个区域
            Select Case configSht.Cells(i, "E").Value
                Case "CustomFormat"
                    CustomFormat targetRange
                Case "CustomFormat1"
                    CustomFormat1 targetRange
            End Select
        Else
            ' 拆分逗号分隔的列名
            colNames = Split(Trim(configSht.Cells(i, "D").Value), ",")
            For Each colName In colNames
                colName = Trim(colName)
                ' 查找列名所在的列
                Set targetCol = targetRange.Rows(1).Find(What:=colName, LookIn:=xlValues, LookAt:=xlWhole)
                If Not targetCol Is Nothing Then
                    ' 应用格式到该列的整个数据区域
                    Select Case configSht.Cells(i, "E").Value
                        Case "CustomFormat"
                            CustomFormat targetRange.Columns(targetCol.Column - targetRange.Column + 1)
                        Case "CustomFormat1"
                            CustomFormat1 targetRange.Columns(targetCol.Column - targetRange.Column + 1)
                    End Select
                Else
                    MsgBox "区域" & targetRange.Address & "中未找到列名" & colName & "，跳过该列", vbExclamation
                End If
            Next colName
        End If
        
NextRow:
        ' 清空对象变量
        Set targetSht = Nothing
        Set targetRange = Nothing
        Set targetCol = Nothing
    Next i
    
    MsgBox "格式化完成", vbInformation
End Sub

Private Sub CustomFormat(rng As Excel.Range)
    With rng
        .VerticalAlignment = xlTop
        .WrapText = True
    End With
End Sub

Private Sub CustomFormat1(rng As Excel.Range)
    With rng
        .VerticalAlignment = xlCenter
        .WrapText = True
    End With
End Sub

关键修改说明 #

• 逻辑重构：改为直接遍历配置表的每一行，避免原代码中遍历所有工作表和名称的低效逻辑，更贴合需求
• 错误处理：添加工作表、区域、列名不存在的检查，避免宏崩溃并给出提示
• 特殊值处理：单独处理"All Columns"的情况，直接对整个目标区域应用格式
• 列名解析：拆分逗号分隔的列名字符串，通过Find方法精准定位目标列
• 代码规范：修复原代码中变量重复定义、循环嵌套混乱的问题，使用With语句优化格式化代码
• 访问控制：将格式化函数改为Private，避免不必要的外部调用

内容的提问来源于stack exchange，提问作者adifadipe