Excel VBA格式化范围

Question

我有一个子表格格式特定的范围，我想使它更有效率（它从运行宏记录器复制并工作正常）。我也希望合并代码，以便如果添加一列（通常在列C到E），格式不受影响。一些指针，将不胜感激

Sub Format_Summary_Sheet() 
' 
' Format Summary Sheet Macro 
' 
Dim i1stSumRow As Integer 

Sheets("Summary").Select 'Activate Summary sheet 

Application.ScreenUpdating = True 

    With ActiveSheet 
     i1stSumRow = Cells(.Rows.Count, "I").End(xlUp).Row 
     .Range("I" & (i1stSumRow)).Select 
    End With 

Range(Cells(11, 3), Cells(i1stSumRow - 2, 51)).Select 

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone 
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone 

     With Selection.Borders(xlEdgeLeft) 
      .LineStyle = xlContinuous 
      .Weight = xlMedium 
     End With 

     With Selection.Borders(xlEdgeTop) 
      .LineStyle = xlContinuous 
      .Weight = xlThin 
     End With 

     With Selection.Borders(xlEdgeBottom) 
      .LineStyle = xlContinuous 
      .Weight = xlThin 
     End With 

     With Selection.Borders(xlEdgeRight) 
      .LineStyle = xlContinuous 
      .Weight = xlMedium 
     End With 

     With Selection.Borders(xlInsideHorizontal) 
      .LineStyle = xlContinuous 
      .Weight = xlThin 
     End With 

Range(Cells(i1stSumRow - 2, 1), Cells(i1stSumRow - 2, 51)).Select 

    With Selection.Borders(xlEdgeBottom) 
     .LineStyle = xlContinuous 
     .Weight = xlMedium 
    End With 

Range(Cells(11, 2), Cells(i1stSumRow - 2, 2)).Select 'Removes borders from Column B 

    Selection.Borders(xlInsideVertical).LineStyle = xlNone 
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone 
    Selection.Borders(xlEdgeTop).LineStyle = xlNone 
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone 

Range(Cells(11, 6), Cells(i1stSumRow - 2, 6)).Select 'Removes borders from Column F 

    Selection.Borders(xlInsideVertical).LineStyle = xlNone 
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone 
    Selection.Borders(xlEdgeTop).LineStyle = xlNone 
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone 

Range(Cells(11, 8), Cells(i1stSumRow - 2, 8)).Select 'Removes borders from Column H 

    Selection.Borders(xlInsideVertical).LineStyle = xlNone 
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone 
    Selection.Borders(xlEdgeTop).LineStyle = xlNone 
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone 

Range(Cells(11, 17), Cells(i1stSumRow - 2, 17)).Select 'Removes borders from Column Q 

    Selection.Borders(xlInsideVertical).LineStyle = xlNone 
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone 
    Selection.Borders(xlEdgeTop).LineStyle = xlNone 
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone 

Range(Cells(11, 24), Cells(i1stSumRow - 2, 24)).Select 'Removes borders from Column X 

    Selection.Borders(xlInsideVertical).LineStyle = xlNone 
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone 
    Selection.Borders(xlEdgeTop).LineStyle = xlNone 
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone 

Range(Cells(11, 33), Cells(i1stSumRow - 2, 33)).Select 'Removes borders from Column AG 

    Selection.Borders(xlInsideVertical).LineStyle = xlNone 
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone 
    Selection.Borders(xlEdgeTop).LineStyle = xlNone 
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone 

Range(Cells(11, 37), Cells(i1stSumRow - 2, 37)).Select 'Removes borders from Column AK 

    Selection.Borders(xlInsideVertical).LineStyle = xlNone 
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone 
    Selection.Borders(xlEdgeTop).LineStyle = xlNone 
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone 

Range(Cells(11, 39), Cells(i1stSumRow - 2, 39)).Select 'Removes borders from Column AM 

    Selection.Borders(xlInsideVertical).LineStyle = xlNone 
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone 
    Selection.Borders(xlEdgeTop).LineStyle = xlNone 
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone 

Range(Cells(11, 48), Cells(i1stSumRow - 2, 48)).Select 'Removes borders from Column AV 

    Selection.Borders(xlInsideVertical).LineStyle = xlNone 
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone 
    Selection.Borders(xlEdgeTop).LineStyle = xlNone 
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone 
Range("H7").Select 
Range("C10").Select 

End Sub 

Answer 1

的感知效率最有可能的罪魁祸首是当您运行宏，ScreenUpdating启用。尝试使用Application.ScreenUpdating = false ... Application.ScreenUpdating = True包围格式代码。

为了免除添加列（或行）的代码，为应格式化的单元格块创建一个命名范围，并将该范围称为Names("RangeName").RefersToRange，其中“RangeName”是NamedRange名称（in双引号，它是一个字符串文字）。

Answer 2

摆脱Select

我会做的第一件事情，因为代码选择了“特定范围”，是指定一个命名的范围，并在你的代码，而不是Select使用是范围对象。一般来说，usage of Select in your VBA code is to be avoided。

简单的方法是在每次范围变化时（例如，设置MyRange等于=$C$11:$AY$19;根据需要更改），简单地手动创建/编辑命名范围。下行：如果你不得不执行这项任务，每次做这个改变都是很大的时间。

相反，你可以指定一个dynamic named range defining the last used row in Column I using something like this as the formula（做一个命名的范围，做Formulas - >Define Name）：

=INDEX($I:$I,MAX(($I:$I<>"")*(ROW($I:$I)))) 'Note: works only in 2007 or above 

也许称之为LastI。

然后创建一个定义要格式化的更大范围的基础上LastI另一个名为范围：

=$C$11:INDEX($AY:$AY,ROW(LastI)-2) 

也许称之为一个MyRange。

现在在VBA中，你可以做这样的事情使用您的命名范围：

Private Sub FormatAnyRange(MyRange As Range) 

    With MyRange 
     .Borders(xlDiagonalDown).LineStyle = xlNone 

     With .Borders(xlEdgeLeft) 
      .LineStyle = xlContinuous 
      .Weight = xlMedium    
     End With 

    End With 

End Sub 

呼叫使用这样一个单独的程序上面的程序：

Sub CallFormatAnyRange() 

    Dim MyRange As Range 

    Set MyRange = Range("MyRange") 

    Call FormatAnyRange(MyRange) 

End Sub 

注意：您要分割这分成两个任务（即Sub s），以便您可以重复使用您发送给它的任何范围的第一个过程。例如，如果要设置格式手动选择的范围，你可以创建这个过程，将当前Selection你的第一个程序：

Sub FormatSelectedRange() 

    Call FormatAnyRange(Selection) 
    'Note this is likely to throw errors if you don't 
    'have a valid Range Object selected 

End Sub 

---

测试

您可以进行测试，以通过在任何单元格中输入像这样的函数（以范围作为参数的函数），确保您的动态命名范围正常工作：

=ROW(LastI) 
=COLUMNS(MyRange) 
=SUMPRODUCT(MySnappyDynamicRange) 

然后做Formulas→Evaluate Formula→Evaluate。这将显示您的动态命名范围正在解析的实际单元格范围地址。

---

还有一些其他的事情，我会建议为表现不俗（例如，摆脱重复的代码，进一步分裂的过程分成不同的程序作为有道理，等等等等），但这是一个好的开始 - 它会清理一些东西。让它成为你的目标，摆脱Select的每一个外观;这将使您的代码更好，并为您创建扩展VBA知识的机会。

Answer 3

根据您的代码，它看起来像重复多次删除列的边框。每当我发现自己使用CTRL +Ç（复印件）和CTRL +v（膏）比在脚本几次，我D.R.Y.警报熄灭。 （Here's a link to the Don't Repeat Yourself entry on Wikipedia）

以下是未经测试：

Public Sub RemoveBorders(Target As Range) 
    'skip this routine if the passed-in range is Nothing 
    If Target Is Nothing Then Exit Sub 

    'execute the border removal 
    Target.Borders(xlInsideVertical).LineStyle = xlNone 
    Target.Borders(xlInsideHorizontal).LineStyle = xlNone 
    Target.Borders(xlEdgeTop).LineStyle = xlNone 
    Target.Borders(xlEdgeBottom).LineStyle = xlNone 
End Sub 

通过增加公共子程序现有的子程序低于（或者，甚至更好，将它添加到你的模块专门用于佣工），您Format_Summary_Sheet()代码现在的俏皮话的边界去除工艺得到简化：

Sub Format_Summary_Sheet() 

    Dim i1stSumRow As Integer 
    Dim TempRange As Range 
    Dim MySheet As Worksheet 

    '... set references up front 
    Set MySheet = ThisWorkbook.ActiveSheet 
    'or, to improve this even more, assign the sheet by name: 
    'Set MySheet = ThisWorkbook.Worksheets("CoolSheetName") 

    '... doing other stuff 

    'remove borders section 
    With MySheet 
     Set TempRange = .Range(.Cells(11, 2), .Cells(i1stSumRow - 2, 2)) '<~ col F 
     Call RemoveBorders(TempRange) 
     Set TempRange = .Range(.Cells(11, 6), .Cells(i1stSumRow - 2, 6)) '<~ col H 
     Call RemoveBorders(TempRange) 
     Set TempRange = .Range(.Cells(11, 17), .Cells(i1stSumRow - 2, 17)) '<~ col Q 
     Call RemoveBorders(TempRange) 
     '... repeat this pattern for columns X, AG, AK, AM and AV 
    End With 

    '... the rest of your code 

End Sub 

通过这里晒你的脚本，你风与代码这不仅更容易阅读，也更容易维护。现在，您的删除边界的逻辑被包含在一个例程中，如果您需要进行更改，则只需执行一次。