1. 首頁
  2. 問答
  3. VBA繪製邊框

VBA繪製邊框

2017-03-03 158 views
1

下面是我使用其中一個電子表格進行格式設置的代碼，它的工作原理沒有任何錯誤。VBA繪製邊框

這是有點冗長，因爲我從宏錄像機得到這個，並修改了一下。

我遇到的這個腳本的問題是大約需要5到10秒才能完成工作。

無論如何縮短這段代碼並加快這個過程？

Sub FORMAT() 

Application.ScreenUpdating = False 


Range("B5:EM5000").Select 
Selection.Borders(xlEdgeLeft).LineStyle = xlNone 
    Selection.Borders(xlEdgeTop).LineStyle = xlNone 
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone 
    Selection.Borders(xlEdgeRight).LineStyle = xlNone 
    Selection.Borders(xlInsideVertical).LineStyle = xlNone 
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone 

    ''''' 
    Range("B5:D5").Select 
    Range(Selection, Selection.End(xlDown)).Select 

    With Selection.Borders(xlEdgeLeft) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeTop) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeBottom) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeRight) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlInsideVertical) 
     .LineStyle = xlContinuous 

     .TintAndShade = 0 
     .Weight = xlHairline 
    End With 
    With Selection.Borders(xlInsideHorizontal) 
     .LineStyle = xlContinuous 
     .TintAndShade = 0 
     .Weight = xlHairline 
    End With 

     ''''' 
    Range("B5:c5").Select 
    Range(Selection, Selection.End(xlDown)).Offset(0, 3).Select 

    With Selection.Borders(xlEdgeLeft) 
     .LineStyle = xlDouble 
    .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeTop) 
     .LineStyle = xlDouble 
     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeBottom) 
     .LineStyle = xlDouble 
     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeRight) 
     .LineStyle = xlDouble 
     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlInsideVertical) 
     .LineStyle = xlContinuous 
     .TintAndShade = 0 
     .Weight = xlHairline 
    End With 
    With Selection.Borders(xlInsideHorizontal) 
     .LineStyle = xlContinuous 
     .TintAndShade = 0 
     .Weight = xlHairline 
    End With 
    ''''' 
Range("B5:c5").Select 
    Range(Selection, Selection.End(xlDown)).Resize(, 25).Offset(0, 5).Select 
    With Selection.Borders(xlEdgeLeft) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeTop) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeBottom) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeRight) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlInsideVertical) 
     .LineStyle = xlContinuous 

     .TintAndShade = 0 
     .Weight = xlHairline 
    End With 
    With Selection.Borders(xlInsideHorizontal) 
     .LineStyle = xlContinuous 

     .TintAndShade = 0 
     .Weight = xlHairline 
    End With 


     ''''' 

    Range("B5:c5").Select 
    Range(Selection, Selection.End(xlDown)).Resize(, 11).Offset(0, 27).Select 


    With Selection.Borders(xlEdgeLeft) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeTop) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeBottom) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeRight) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlInsideVertical) 
     .LineStyle = xlContinuous 

     .TintAndShade = 0 
     .Weight = xlHairline 
    End With 
    With Selection.Borders(xlInsideHorizontal) 
     .LineStyle = xlContinuous 

     .TintAndShade = 0 
     .Weight = xlHairline 
    End With 


     ''''' 

     ''''' 

    Range("B5:l5").Select 
    Range(Selection, Selection.End(xlDown)).Offset(0, 39).Select 


    With Selection.Borders(xlEdgeLeft) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeTop) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeBottom) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeRight) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlInsideVertical) 
     .LineStyle = xlContinuous 

     .TintAndShade = 0 
     .Weight = xlHairline 
    End With 
    With Selection.Borders(xlInsideHorizontal) 
     .LineStyle = xlContinuous 

     .TintAndShade = 0 
     .Weight = xlHairline 
    End With 





    '''''''''''''' 

     ''''' 

    Range("B5:k5").Select 
    Range(Selection, Selection.End(xlDown)).Offset(0, 50).Select 


    With Selection.Borders(xlEdgeLeft) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeTop) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeBottom) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeRight) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlInsideVertical) 
     .LineStyle = xlContinuous 

     .TintAndShade = 0 
     .Weight = xlHairline 
    End With 
    With Selection.Borders(xlInsideHorizontal) 
     .LineStyle = xlContinuous 

     .TintAndShade = 0 
     .Weight = xlHairline 
    End With 





    '''''''''''''' 

     ''''' 

    Range("B5:k5").Select 
    Range(Selection, Selection.End(xlDown)).Offset(0, 60).Select 


    With Selection.Borders(xlEdgeLeft) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeTop) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeBottom) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeRight) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlInsideVertical) 
     .LineStyle = xlContinuous 

     .TintAndShade = 0 
     .Weight = xlHairline 
    End With 
    With Selection.Borders(xlInsideHorizontal) 
     .LineStyle = xlContinuous 

     .TintAndShade = 0 
     .Weight = xlHairline 
    End With 





    '''''''''''''' 
     ''''' 

    Range("B5:k5").Select 
    Range(Selection, Selection.End(xlDown)).Offset(0, 70).Select 


    With Selection.Borders(xlEdgeLeft) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeTop) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeBottom) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeRight) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlInsideVertical) 
     .LineStyle = xlContinuous 

     .TintAndShade = 0 
     .Weight = xlHairline 
    End With 
    With Selection.Borders(xlInsideHorizontal) 
     .LineStyle = xlContinuous 

     .TintAndShade = 0 
     .Weight = xlHairline 
    End With 





    '''''''''''''' 

     ''''' 

    Range("B5:k5").Select 
    Range(Selection, Selection.End(xlDown)).Offset(0, 80).Select 


    With Selection.Borders(xlEdgeLeft) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeTop) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeBottom) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeRight) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlInsideVertical) 
     .LineStyle = xlContinuous 

     .TintAndShade = 0 
     .Weight = xlHairline 
    End With 
    With Selection.Borders(xlInsideHorizontal) 
     .LineStyle = xlContinuous 

     .TintAndShade = 0 
     .Weight = xlHairline 
    End With 





    '''''''''''''' 




     ''''' 

    Range("B5:k5").Select 
    Range(Selection, Selection.End(xlDown)).Offset(0, 90).Select 


    With Selection.Borders(xlEdgeLeft) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeTop) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeBottom) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeRight) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlInsideVertical) 
     .LineStyle = xlContinuous 

     .TintAndShade = 0 
     .Weight = xlHairline 
    End With 
    With Selection.Borders(xlInsideHorizontal) 
     .LineStyle = xlContinuous 

     .TintAndShade = 0 
     .Weight = xlHairline 
    End With 





    '''''''''''''' 





     ''''' 

    Range("B5:k5").Select 
    Range(Selection, Selection.End(xlDown)).Offset(0, 100).Select 


    With Selection.Borders(xlEdgeLeft) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeTop) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeBottom) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeRight) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlInsideVertical) 
     .LineStyle = xlContinuous 

     .TintAndShade = 0 
     .Weight = xlHairline 
    End With 
    With Selection.Borders(xlInsideHorizontal) 
     .LineStyle = xlContinuous 

     .TintAndShade = 0 
     .Weight = xlHairline 
    End With 





    '''''''''''''' 


    Range("B5:k5").Select 
    Range(Selection, Selection.End(xlDown)).Offset(0, 110).Select 


    With Selection.Borders(xlEdgeLeft) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeTop) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeBottom) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeRight) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlInsideVertical) 
     .LineStyle = xlContinuous 

     .TintAndShade = 0 
     .Weight = xlHairline 
    End With 
    With Selection.Borders(xlInsideHorizontal) 
     .LineStyle = xlContinuous 

     .TintAndShade = 0 
     .Weight = xlHairline 
    End With 





    '''''''''''''' 

    '''''''''''''' 


    Range("B5:k5").Select 
    Range(Selection, Selection.End(xlDown)).Offset(0, 120).Select 


    With Selection.Borders(xlEdgeLeft) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeTop) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeBottom) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeRight) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlInsideVertical) 
     .LineStyle = xlContinuous 

     .TintAndShade = 0 
     .Weight = xlHairline 
    End With 
    With Selection.Borders(xlInsideHorizontal) 
     .LineStyle = xlContinuous 

     .TintAndShade = 0 
     .Weight = xlHairline 
    End With 





    '''''''''''''' 

    '''''''''''''' 


    Range("B5:k5").Select 
    Range(Selection, Selection.End(xlDown)).Offset(0, 130).Select 


    With Selection.Borders(xlEdgeLeft) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeTop) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeBottom) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeRight) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlInsideVertical) 
     .LineStyle = xlContinuous 

     .TintAndShade = 0 
     .Weight = xlHairline 
    End With 
    With Selection.Borders(xlInsideHorizontal) 
     .LineStyle = xlContinuous 

     .TintAndShade = 0 
     .Weight = xlHairline 
    End With 

    '''''''' 
    '''''''''''''' 


    Range("B5:k5").Select 
    Range(Selection, Selection.End(xlDown)).Offset(0, 140).Select 


    With Selection.Borders(xlEdgeLeft) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeTop) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeBottom) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeRight) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlInsideVertical) 
     .LineStyle = xlContinuous 

     .TintAndShade = 0 
     .Weight = xlHairline 
    End With 
    With Selection.Borders(xlInsideHorizontal) 
     .LineStyle = xlContinuous 

     .TintAndShade = 0 
     .Weight = xlHairline 
    End With 

    Range("B5").Select 
    Range(Selection, Selection.End(xlDown)).Offset(0, 38).Select 


    With Selection.Borders(xlEdgeLeft) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeTop) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeBottom) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlEdgeRight) 
     .LineStyle = xlDouble 

     .TintAndShade = 0 
     .Weight = xlThick 
    End With 
    With Selection.Borders(xlInsideVertical) 
     .LineStyle = xlContinuous 

     .TintAndShade = 0 
     .Weight = xlHairline 
    End With 
    With Selection.Borders(xlInsideHorizontal) 
     .LineStyle = xlContinuous 

     .TintAndShade = 0 
     .Weight = xlHairline 
    End With 



    '''''''' 




    '''''''''''''' 
     Range("AP5").Select 
    Range(Selection, Selection.End(xlDown)).Select 

    Selection.Rows.AutoFit 


    '''''''''''''' 

     Range("e:f").Select 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.NumberFormat = "mmm-yy;@" 

    Range("g:h").Select 
     Range(Selection, Selection.End(xlDown)).Select 
     Selection.NumberFormat = "#,##0" 





    '''''' 

    Range("B5:EM5000").Select 

    With Selection.Font 
     .Name = "Calibri" 
     .SIZE = 8 

    End With 




    Application.ScreenUpdating = True 

End Sub

來源

2017-03-03 Sahal

+0

這個問題有點廣泛的答案。但我建議不要將表單格式化爲最後一行。我相信你永遠不會使用完整的'1 048 576'行。將格式限制爲行1000或其他內容會更快。你不需要選擇單元格。您可以直接格式化它們'帶範圍（「B5：D5」）。邊界（xlEdgeLeft）'。 –

+1

不要先選擇細胞，這是需要額外的時間。只需直接使用Range對象，例如'Range（「B5：C5」）。Borders.Selection.Borders（xlEdgeLeft）.LineStyle = xlDouble'。有關詳細信息，請參閱[如何避免使用Excel VBA宏中的選擇]（http://stackoverflow.com/a/10717999/1490783） –

+0

@Peh 我有另一個將數據插入列B的VBA代碼：D，和行數不同，這就是我在這裏使用「最後一行」的原因。所以我認爲只寫'Range（「B5：D5」）'沒有「最後一行不是正確的方式來覆蓋列B中的所有數據：D – Sahal

回答

0

想想邊框線條：上，右，下，左，垂直線（範圍內）和水平線條（範圍內）的代碼

一號線將吸引所有線路爲範圍。你可以修改它們以得到你想要的。

要獲得乾淨的代碼和更好的代碼執行控制，您應該學會編寫函數，作爲示例，我編寫了一個函數，該函數爲您提供給定工作表中給定列中的最後一行。

Sub DrawBorder() 
    Dim lRow As Integer 
    Dim cell As Range 
    Dim rng As Range 
    Dim WS As Worksheet 

    Set WS = ActiveSheet 'you can set this to a specific sheet like Set WS=Sheets("Sheet1") 

    'Clear all of the borders in the sheet 
    WS.Cells.Borders.LineStyle = xlNone 

    'Find the last row in column B=2 
    lRow = LastRowInColumn(WS, 2) 

    Set rng = WS.Range("B5:D" & lRow) 

    'Borders of the cells inside the range 
    rng.Borders.LineStyle = xlDot 

    'Border of the range as a whole with double lines 
    rng.Borders(xlEdgeTop).LineStyle = xlDouble 
    rng.Borders(xlEdgeBottom).LineStyle = xlDouble 
    rng.Borders(xlEdgeLeft).LineStyle = xlDouble 
    rng.Borders(xlEdgeRight).LineStyle = xlDouble 

' 'You can use these lines to remove the vertical/horizontal lines isnide a range 
' rng.Borders(xlInsideVertical).LineStyle = xlNone 
' rng.Borders(xlInsideHorizontal).LineStyle = xlNone 

End Sub 


Function LastRowInColumn(Optional sh As Worksheet, Optional colNumber As Long = 1) As Long 
    'Finds the last row in a particular column which has a value in it 
    If sh Is Nothing Then 
     Set sh = ActiveSheet 
    End If 
    LastRowInColumn = sh.Cells(sh.Rows.Count, colNumber).End(xlUp).Row 
End Function

來源

2017-03-04 00:20:03 Ibo

相關問題

 相關問題