excel - 有没有办法加快格式化数千行？

Question

我制作了以下代码，它消除了对 for 循环的需要，但它仍然卡住了 Excel。
这段代码本质上将使用边框、数字格式等以特定方式格式化 8 行。我需要加快速度，因为我正在运行它与我编写的另一个宏一起运行，该宏在合理的时间内工作，但添加这种格式会造成一些困惑。

Sub Format()
'Borders
Range("A2:F9,G2:I3,G4:I5,G6:I7,G8:I9,J2:V3,J4:V5,J6:V7,J8:V9,W2:W9,X2:AI3,X4:AI5,X6:AI7,X8:AI9,AJ2:AJ9").Select
With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With

'Format percentages
Range("X3:AI3,X5:AI5,X7:AI7,X9:AI9").Select
Selection.NumberFormat = "0.00%"

Range("F:F,J2:W" & endRow).Select
Selection.NumberFormat = "0"

Range("J1:V1").Select
Selection.NumberFormat = "mmm-yy"

Range("X1:AI1").Select
Selection.NumberFormat = "mmm"

'Text Alignment
Range("A:A,C:C,D:D,F:AJ").Select
With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .ReadingOrder = xlContext
End With

Range("A2:AJ9").Copy
Range("A2:AJ" & endRow).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

Range("A1,C1,D1,F1:I1,W1,AJ1").EntireColumn.AutoFit
Range("B1").ColumnWidth = 32
Range("E1").ColumnWidth = 40
Range("J1:V1,X1:AI1").ColumnWidth = 7.5
End Sub

变量 endRow 在其他地方确定，因为该宏在另一个内部调用。
为简单起见，我们假设 endRow = 80,002(额外的 2 占标题)。
编辑1:
为澄清起见，有一个标题行，然后要格式化的数据如下。此代码的几行修改了 header 数据，因此以下是没有对 header 进行格式化的代码，以便清楚地解决问题。

Sub Format()
'Borders
Range("A2:F9,G2:I3,G4:I5,G6:I7,G8:I9,J2:V3,J4:V5,J6:V7,J8:V9,W2:W9,X2:AI3,X4:AI5,X6:AI7,X8:AI9,AJ2:AJ9").Select
With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With

'Format percentages
Range("X3:AI3,X5:AI5,X7:AI7,X9:AI9").Select
Selection.NumberFormat = "0.00%"

Range("F:F,J2:W" & endRow).Select
Selection.NumberFormat = "0"

'Text Alignment
Range("A:A,C:C,D:D,F:AJ").Select
With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .ReadingOrder = xlContext
End With

Range("A2:AJ9").Copy
Range("A2:AJ" & endRow).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

Range("A1,C1,D1,F1:I1,W1,AJ1").EntireColumn.AutoFit
Range("B1").ColumnWidth = 32
Range("E1").ColumnWidth = 40
Range("J1:V1,X1:AI1").ColumnWidth = 7.5
End Sub

编辑2:

我尝试了蒂姆威廉姆斯的建议，但这只会导致所有单元格都有我不想要的所有边界。
编辑3:
这篇文章变得相当长，但这是我想出的，我怀疑可以进一步优化，但我不确定如何实现。

Sub Format()
Dim rng As Range
Set rng = Sht.Range("A2:F9,G2:I3,G4:I5,G6:I7,G8:I9,J2:V3,J4:V5,J6:V7,J8:V9,W2:W9,X2:AI3,X4:AI5,X6:AI7,X8:AI9,AJ2:AJ9")
'Borders
With rng.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With
With rng.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With
With rng.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With
With rng.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With

'Format percentages
Range("X3:AI3,X5:AI5,X7:AI7,X9:AI9").NumberFormat = "0.00%"

Range("F:F,J2:W" & endRow).NumberFormat = "0"

Range("J1:V1").NumberFormat = "mmm-yy"

Range("X1:AI1").NumberFormat = "mmm"

'Text Alignment
With Range("A:A,C:C,D:D,F:AJ")
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .ReadingOrder = xlContext
End With

Range("A2:AJ9").Copy
Range("A2:AJ" & endRow).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Range("A1,C1,D1,F1:I1,W1,AJ1").EntireColumn.AutoFit
Range("B1").ColumnWidth = 32
Range("E1").ColumnWidth = 40
Range("J1:V1,X1:AI1").ColumnWidth = 7.5
End Sub

Answer 1

格式化数千行

Sub Format()
    
    Const EndRow As Long = 80001
    
    Application.ScreenUpdating = False
    
    With ActiveSheet ' improve!
        
        ' Borders
        With .Range("A2:F9,G2:I3,G4:I5,G6:I7,G8:I9,J2:V3,J4:V5," _
                & "J6:V7,J8:V9,W2:W9,X2:AI3,X4:AI5,X6:AI7,X8:AI9,AJ2:AJ9")
            With .Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .Weight = xlMedium
            End With
            With .Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .Weight = xlMedium
            End With
            With .Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlMedium
            End With
            With .Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlMedium
            End With
        End With
        
        ' Number Formats
        .Range("X3:AI3,X5:AI5,X7:AI7,X9:AI9").NumberFormat = "0.00%"
        .Range("F1:F9,J2:W9").NumberFormat = "0"
        .Range("J1:V1").NumberFormat = "mmm-yy"
        .Range("X1:AI1").NumberFormat = "mmm"
    
        ' Text Alignment
        With .Range("A1:A9,C1:C9,D1:D9,F1:AJ9")
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
            .ReadingOrder = xlContext
        End With
        
        ' Copy Down Formats
        .Range("A2:AJ9").Copy
        .Range("A2:AJ" & EndRow).PasteSpecial Paste:=xlPasteFormats
        
        ' Column Widths
        .Range("A1,C1,D1,F1:I1,W1,AJ1").EntireColumn.AutoFit
        .Range("B1").ColumnWidth = 32
        .Range("E1").ColumnWidth = 40
        .Range("J1:V1,X1:AI1").ColumnWidth = 7.5
    
    End With
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    
End Sub

争论

通过添加工作表参数重写前一个子。

Sub FormatSheet(ByVal ws As Worksheet)

    Const EndRow As Long = 80001

    Application.ScreenUpdating = False

    With ws
    

    End With

    Application.CutCopyMode = False
    Application.ScreenUpdating = True

End Sub

最后，从另一个 sub 调用 sub。

Sub Test()

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    FormatSheet ws

End Sub

同样，您可以添加 EndRow争论...

Sub FormatSheet2(ByVal ws As Worksheet, ByVal EndRow As Long)

End Sub

并用例如调用它:

FormatSheet2 ws, 80001