Question

我正在尝试创建一个循环，以基于3个工作表中的单元格中的文本来更改字体类型和字体颜色，每个工作表均具有命名的动态范围。我无法选择工作表上的所有单元格，因为在该范围上方的单元格中有一个图例。

我已经成功地分别格式化了每个范围，但是我想知道是否有更有效的方法。我知道Range不能在多个工作表上工作。我尝试将Collection和Array与命名范围一起使用。我显然不明白如何使用它们，因为两者都不起作用。

我一直在努力解决这一问题。我读了很多文章，但是大多数文章都试图在工作表中定义的范围内执行功能。我对VBA（所有编码）都很陌生，这是我最近来的。

这是行得通的。

Sub Macro3()

Dim daily As Worksheet, mon As Worksheet, per As Worksheet
Dim ws As Worksheet, cell As Range
Dim d1 As Range, m1 As Range, p1 As Range

Set daily = Sheets("Daily")
Set mon = Sheets("Monthly")
Set per = Sheets("Personnel")
Set d1 = daily.Range(("A7"), daily.Range("A7").End(xlUp) _
   .Offset(-1, 46))
Set m1 = mon.Range("A6:Y6")
Set p1 = per.Range(("A4"), per.Range("A4").End(xlUp).Offset(1, 20))

With d1
    Cells.Replace What:="", Replacement:="T"
    Cells.Replace What:="Incomplete", Replacement:="T"
    Cells.Replace What:="Complete", Replacement:="R"
    Cells.Replace What:="Not Applicable", Replacement:="x"
End With

d1.HorizontalAlignment = xlCenter

For Each cell In d1
    If cell.Value = "T" Then
        cell.Font.Name = "Wingdings 2"
    ElseIf cell.Value = "R" Then
        cell.Font.Name = "Wingdings 2"
    ElseIf cell.Value = "x" Then
        cell.Font.Name = "Webdings"
    ElseIf cell.Value = "v" Then
        cell.Font.Name = "Wingdings"
    End If
Next

With d1
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).Weight = xlThin
.Borders(xlEdgeLeft).Weight = xlMedium
.Borders(xlEdgeTop).Weight = xlMedium
.Borders(xlEdgeBottom).Weight = xlMedium
.Borders(xlEdgeRight).Weight = xlMedium
End With

' this is repeated for m1 and then p1
End Sub

这不是

Set dta_all = Array(Sheets("Daily").daily.Range(("A7"), _ 
        daily.Range("A7").End(xlUp).Offset(-1, 46)), _
        Sheets("Monthly").Range("A6:Y6"), _
       Sheets("Personnel").Range(("A4"), _
        per.Range("A4").End(xlUp).Offset(1, 20)))

For Each ws In ThisWorkbook.Worksheets
    For Each cell In dta_all
        If cell.Text = "Incomplete" Then
            cell.Value = "T"
            cell.Font.Name = "Wingdings 2"
            cell.Font.Bold = True
            cell.Font.Color = vbRed
        End If
    Next
Next

我收到438错误-不支持属性或方法。非常感谢您的帮助。

Answer 1

如果您查看代码的公共/重复部分：

With d1
    .Cells.Replace What:="", Replacement:="T"
    'etc
End With

d1.HorizontalAlignment = xlCenter

For Each cell In d1
   'etc
Next

With d1
    .Borders(xlInsideVertical).Weight = xlThin
    'etc
End With

您可以做的是创建一个仅包含这些部分的单独子程序，该子程序将Range作为参数：

Sub ApplyFormat(rng As Range)
    With rng
        .Cells.Replace What:="", Replacement:="T"
        'etc
    End With

    rng.HorizontalAlignment = xlCenter

    For Each cell In rng.Cells
       'etc
    Next

    With rng
        .Borders(xlInsideVertical).Weight = xlThin
        'etc
    End With
End sub

...然后从主代码中调用if：

ApplyFormat d1
ApplyFormat m1
ApplyFormat p1

每当您发现同一行行不止一次写出时，它可能是分解成单独的子行的一个不错的选择：识别变量部分，并在子行或函数中为其设置参数。

Answer 2

您可以创建一系列范围（我以前从未尝试过，但是要牢记一个不错的选择）。重用您的代码，并且按照Tim的建议，我已经制作了一个示例，请参见以下内容：

Option Explicit
Sub Macro3()

Dim wb As Workbook: Set wb = ActiveWorkbook
Dim daily As Worksheet, mon As Worksheet, per As Worksheet

Set daily = wb.Sheets("Daily")
Set mon = wb.Sheets("Monthly")
Set per = wb.Sheets("Personnel")

'Take the ranges into an array of ranges
Dim arrRanges(1 To 3) As Range   'add more as needed

'Set each element of the array as you would have with normal variables
Set arrRanges(1) = daily.Range(("A7"), daily.Range("A7").End(xlUp).Offset(-1, 46)) 'd1
Set arrRanges(2) = mon.Range("A6:Y6") 'm1
Set arrRanges(3) = per.Range(("A4"), per.Range("A4").End(xlUp).Offset(1, 20)) 'p1

Dim R As Long, C As Long, X As Long

'Now you can loop through
    For X = LBound(arrRanges) To UBound(arrRanges)  'For each of the ranges
        For R = 2 To arrRanges(X).Rows.Count    'For each row in each range - except headers
            For C = 1 To arrRanges(X).Columns.Count 'For each column in each range
                'Debug.Print arrRanges(X).Cells(R, C).Address 'for debuging purposes
                With arrRanges(X)
                    .Cells(R, C).Value = setReplacements(.Cells(R, C).Value)
                    Call setFont(.Cells(R, C))
                End With
            Next C
        Next R

        With arrRanges(X).Offset(1, 0)
            .Resize(.Rows.Count - 1).HorizontalAlignment = xlCenter 'align everything except headers
            Call setBorders(.Resize(.Rows.Count - 1)) 'set borders to everything except headers
        End With
    Next X

End Sub

Function setReplacements(str As String)
'Set the replacements here
    Select Case str
        Case "", "Incomplete"
            setReplacements = "T"
        Case "Complete"
            setReplacements = "R"
        Case "Not Applicable"
            setReplacements = "x"
        Case Else
            'do something here
            setReplacements = "T" 'assume incomplete for any other value?
    End Select
End Function

Sub setFont(rng As Range)
'Set your other formatting here
    Select Case rng.Value
        Case "T", "R"
            rng.Font.Name = "Wingdings 2"
        Case "x"
            rng.Font.Name = "Webdings"
        Case "v"
            rng.Font.Name = "Wingdings"
    End Select
End Sub

Sub setBorders(rng As Range)
'Set your borders here
    With rng
        .Borders(xlInsideVertical).Weight = xlThin
        .Borders(xlInsideHorizontal).Weight = xlThin
        .Borders(xlEdgeLeft).Weight = xlMedium
        .Borders(xlEdgeTop).Weight = xlMedium
        .Borders(xlEdgeBottom).Weight = xlMedium
        .Borders(xlEdgeRight).Weight = xlMedium
    End With
End Sub

要记住的一件事...在工作表上循环从来都不是一个好主意，尤其是当您有大量的行时。不幸的是，在格式化方面，您无能为力，但是可以做到。但是，对于常规数据，最好将数据加载到数组中，进行转换，然后再次吐出……与工作表的交互越少，运行速度就越快。

在多个工作表的动态范围内更改字体类型

2 个答案: