Добавление выделения из несмежного пространства в существующее выделение в макросе Excel

Question

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

В приведенном ниже сценарии он настроен на обработку данных в строках: 6, 8-19, 21-60, 63-81.

Все, что предполагается сделать, - это удалить значения в первом столбце данных (sFirstCol = "D") и сместить значения из всех столбцов (E-> AC) в соответствующих строках на одну ячейку влево, оставив самые правые значения столбца пустыми.

Sub RollOver1()
    Dim sFirstCol As String
    Dim sSecCol As String
    Dim sSLastCol As String
    Dim sLastCol As String
    Dim iFirstRow As Integer
    Dim iLastRow As Integer
    Dim excludeRows() As Variant

    sFirstCol = "D"
    sSecCol = "E"
    sSLastCol = "AB"
    sLastCol = "AC"
    iFirstRow = 6
    iLastRow = 81
    excludeRows = Array(7, 20, 61, 62)



    For i = iFirstRow To iLastRow
        Dim bExcludedRow As Boolean
        bExcludedRow = False
        For Each eR In excludeRows
            If eR = i Then
                bExcludedRow = True
            End If
        Next
        If bExcludedRow = False Then
            Range(sSecCol + LTrim(Str(i)) + ":" + sLastCol + LTrim(Str(i))).Select
            Selection.Copy
            Range(sFirstCol + LTrim(Str(i)) + ":" + sSLastCol + LTrim(Str(i))).Select
            ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, IconFileName:=False
            Range(sLastCol + LTrim(Str(i))).Select
            Selection.ClearContents
        End If
    Next

    Range(sFirstCol + LTrim(Str(iFirstRow + 1))).Select
    ActiveCell.FormulaR1C1 = "='Sheet1'!R[4]C[2]"
    Range(sLastCol + LTrim(Str(iFirstRow))).Select
    ActiveCell.FormulaR1C1 = "=RC[-1]+7"

    Range("A1").Select

End Sub

Answer 1

Вот несколько указателей, которые ускорят ваш код:

Dim все переменные

Dim i As long
Dim eR As variant

В начале вашей процедуры установите для расчета значение Вручную, отключите функцию обновления экрана и события.

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

Включите их снова в конце

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = true

Не Select диапазоны, которые вы хотите обработать. Установите переменную и действуйте в соответствии с этим. Пример:

Dim rng as Range
Set rng = Range(sSecCol + LTrim(Str(i)) + ":" + sLastCol + LTrim(Str(i)))
rng.Copy

Не действуйте на листе по одной строке за раз, действуйте на непрерывном расстоянии. В этом случае это потребует более сложных вычислений для обработки строк между исключенными строками, но это будет иметь чистую выгоду.

Есть много способов «переместить» данные, некоторые, вероятно, быстрее, чем Копировать, Вставить, Очистить. Но как только вы примените подсказки выше, вы можете обнаружить, что процедура выполняется достаточно быстро. Если нет, напишите снова.