VBA 在不同工作表中格式化多个表格范围

Question

我在工作表的 B、C、D 和 E 列中有工作表、表名称、列名称和格式详细信息的列表，我希望 VBA 宏循环遍历此列表以在相应工作表的表/名称范围列中应用格式设置或所有列。

请参阅下表和我到目前为止的代码..有人可以帮助修改下面的代码以使其按照我的期望工作吗

#	工作表名称	表名称/范围名称	列名称	格式
1	菲利普	Philip_Test3	评论、日期、时间戳、地区	自定义格式
2	爱德华	爱德华_测试8	城市、地区、模板名称	自定义格式
3	杰西卡	杰西卡_测试2	日期、时间戳、区域	自定义格式1
4	托尼	托尼_测试1	评论、时间戳、区域、模板名称	自定义格式
4	罗杰	Roger_TestNew	所有栏目	自定义格式1

Option Explicit
Sub FormatMultipleRanges()
  Dim Cell As Range
   Dim nm As Name
    Dim sht As Worksheet
    Set sht = ThisWorkbook.ActiveSheet
  Dim myRange As Range
    Set myRange = sht.Range("D2:D9")
    
    Dim FormatRng As Range
    Set FormatRng = sht.Range("E2:E9")

    For Each sht In Worksheets
        If Not IsError(Application.Match(sht.Name, Range("B2:B9"), 0)) Then
        
        For Each nm In ActiveWorkbook.Names
    If Not IsError(Application.Match(nm.RefersToRange.Parent.Name, Range("C2:C9"), 0)) Then

For Each Cell In myRange
    CustomFormat (myRange)
Next myRange
      '
          
        End If
        
    Next
End Sub

格式化功能

public function CustomFormat(rng as excel.range) 

rng.VerticalAlignment = xlTop
rng.WrapText = True    

end function

public function CustomFormat1(rng as excel.range) 

rng.VerticalAlignment = xlCenter
rng.WrapText = True    

end function

Answer 1

微软文档：

ListColumn.DataBodyRange 属性 (Excel)

StrComp 函数

Range.CurrentRegion 属性 (Excel)

Option Explicit
Sub FormatMultipleRanges()
    Dim i As Long, aCol, iVertical As Long
    Dim oSht As Worksheet, oTab As ListObject, oRng As Range
    Dim desSht As Worksheet, arrData
    Set oSht = ThisWorkbook.ActiveSheet
    ' Load data into an array
    arrData = oSht.Range("A1").CurrentRegion.Value
    ' Loop through table
    For i = 2 To UBound(arrData)
        ' Get sheet object
        On Error Resume Next
        Set desSht = Worksheets(arrData(i, 2))
        On Error GoTo 0
        If Not desSht Is Nothing Then
            If desSht.ListObjects.Count > 0 Then
                ' Get table (listobject) object
                On Error Resume Next
                Set oTab = desSht.ListObjects(arrData(i, 3))
                On Error GoTo 0
                If Not oTab Is Nothing Then
                    ' Get the VerticalAlignment setting
                    iVertical = 0
                    If StrComp(arrData(i, 5), "CustomFormat", vbTextCompare) = 0 Then
                        iVertical = xlTop
                    ElseIf StrComp(arrData(i, 5), "CustomFormat1", vbTextCompare) = 0 Then
                        iVertical = xlCenter
                    End If
                    If iVertical <> 0 Then
                        ' Format cols
                        For Each aCol In Split(arrData(i, 4), ",")
                            ' If Col aCol exists in oTab
                            On Error Resume Next
                            Set oRng = oTab.ListColumns(Trim(aCol)).DataBodyRange
                            On Error GoTo 0
                            If Not oRng Is Nothing Then
                                oRng.VerticalAlignment = iVertical
                                oRng.WrapText = True
                            End If
                        Next
                    End If
                End If
            End If
        End If
        Set desSht = Nothing
        Set oTab = Nothing
    Next
End Sub