Диапазоны форматирования Excel VBA

Question

У меня есть sub, который форматирует определенные диапазоны на листе, и я хочу сделать его более эффективным (он был скопирован из запуска макрорекордера и отлично работает). Я также хочу включить код, чтобы, если столбец добавлен, как правило, в столбце 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 (в двойные кавычки, s - строковый литерал).

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 с), чтобы вы могли повторно использовать первую процедуру, используя ЛЮБОЙ диапазон, который вы отправляете на него.Например, если вы хотите форматировать вручную выбранный диапазон, можно создать процедуру, которая посылает текущую 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 

высыхания сценария здесь, ветер с кодом, который не только легче читать, но и проще в обслуживании. Теперь, когда ваша логика удаления границ содержится в одной рутине, если вам когда-либо понадобится внести изменения, вам нужно сделать это один раз.