ボーダーを描画するためのVBA

以下は、私のスプレッドシートで書式設定を行うために使用するコードで、エラーなしで動作します。ボーダーを描画するための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

質問は答えることが少し広いです。しかし、最後の行までシートをフォーマットしないことをお勧めします。完全な '1 048 576'行を決して使用しないと確信しています。行1000までの書式設定を制限すると、はるかに高速になります。そして、あなたは細胞を選択する必要はありません。たとえば、直接フォーマットすることができます。 'With Range（" B5：D5 "）。ボーダー（xlEdgeLeft）'。 –

最初にセルを選択しないでください。つまり、余分な時間がかかります。 Rangeオブジェクトを直接操作するだけです。 Range（ "B5：C5"）。Borders.Selection.Borders（xlEdgeLeft）.LineStyle = xlDouble'。詳細については、[Excel VBAマクロでの選択の使用を避ける方法]を参照してください。（http://stackoverflow.com/a/10717999/1490783） –

@Peh データを列Bに挿入する別のVBAコードがあります。D、行の数が変化するので、これがここで「最後の行」を使用した理由です。だから私はちょうど 'レンジ（「B5：D5」）を書くことだと思う「最終行が列Bのすべてのデータをカバーするために正しい方法ではありません：D – Sahal

線などの境界線について考える：上、右、下、左、（範囲内）の垂直ラインと水平ライン（範囲内）

を1行のコードは、すべての行を描画します範囲のために。あなたはそれらを変更してあなたが望むものを得ることができます。

クリーンなコードを持ち、コードの実行をよりよく制御するには、関数を書く方法を習得する必要があります。例として、与えられたワークシートの特定の列の最後の行を提供する関数を書きました。

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

ボーダーを描画するためのVBA

答えて

関連する問題