Блог

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

В приведенном ниже скрипте я настроил его на обработку данных в строках: 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
  

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

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
  

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

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