Excel VBA格式范围

时间：2014-07-24 12:11:38

标签： excel vba excel-vba

我有一个子页面，可以在工作表上格式化特定范围，我想提高它的效率（它是从运行宏录制器复制而且工作正常）。我还想要合并代码，以便在添加列时，通常在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

3 个答案:

答案 0 :(得分：2)

根据您的代码，您似乎多次重复从列中删除边框操作。每当我发现自己使用 ctrl + c （复制）和 ctrl + v （粘贴）时不止一些在剧本中，我的干警报响起。 （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

通过在此处干燥您的脚本，您可以获得不仅更易于阅读而且更易于维护的代码。现在您删除边框的逻辑包含在一个例程中，如果您需要进行更改，则只需执行一次。

答案 1 :(得分：1)

感知效率低下的最可能的罪魁祸首是在运行宏时启用了ScreenUpdating。尝试使用Application.ScreenUpdating = false ... Application.ScreenUpdating = True包围格式代码。

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

答案 2 :(得分：0)

摆脱Select

我要做的第一件事，因为代码选择＆＃34;特定范围＆＃34;，指定一个命名范围并在代码中使用那个范围对象而不是{{1} }。作为一般规则，usage of Select in your VBA code is to be avoided。

简单的方法是，每次范围更改时，只需手动创建/编辑命名范围（例如，将Select设置为MyRange;根据需要进行更改。缺点：如果你必须经常执行任务，每次进行此更改都是一个重要的时间。

相反，您可以指定dynamic named range defining the last used row in Column I using something like this as the formula（制作命名范围，执行=$C$11:$AY$19 - ＆gt; 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) 。

现在在VBA中，您可以使用命名范围来执行此类操作：

MyRange

使用如下单独的程序调用上述过程：

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 s），以便您可以使用发送给它的任何范围重复使用第一个过程。例如，如果要格式化手动选择的范围，可以创建此过程，将当前Sub发送到第一个过程：

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) - ＆gt; Formulas - ＆gt; Evaluate Formula。这将显示动态命名范围正在解析的实际单元格范围地址。

我还建议你做其他一些事情（例如，摆脱重复的代码，进一步将你的程序拆分成不同的程序，等等），但这是一个好的开始 - 它会清理事情相当多。让你的目标摆脱Evaluate的每一个表象;这将使您的代码更好，并为您创建扩展VBA知识的机会。

相关问题
最新问题