Блог

У меня есть задача перетаскивать формулы в несколько столбцов на основе длины одного конкретного столбца (длина которого может варьироваться).

Мне удалось это сделать, но пришлось создавать новую строку кода для каждого диапазона.
Пример моего варианта 1:

 Sub DragRows()
        
    Dim LastRowEPS As Integer
    Dim tr As Range
    
    Set tr = Range("A14:G" amp; LastRowEPS)
    
    Range("A14:G14").Select
    Selection.AutoFill Destination:=tr, Type:=xlFillDefault
    
    Set tr = Range("I14:K" amp; LastRowEPS)
    
    Range("I14:K14").Select
    Selection.AutoFill Destination:=tr, Type:=xlFillDefault
    
End Sub
  

Я хочу оптимизировать свой код и включить несколько диапазонов переменных в одну строку кода.
Вот мой вариант 2:

 Sub DragRows()
    
    Dim LastRowEPS As Integer
    Dim tr As Range
    
    LastRowEPS = Sheet1.Cells(14, 12).End(xlDown).Row
    
    Set tr = Range("A14:G" amp; LastRowEPS amp; ", I14:K" amp; LastRowEPS amp; ", M14:N" amp; LastRowEPS amp; ", P14:P" amp; LastRowEPS)
    
    Range("A14:G14,I14:K14,M14:N14,P14:P14").Select
    Selection.AutoFill Destination:=tr, Type:=xlFillDefault
    
End Sub
  

Процесс выбора работает и tr.Range определен правильно, но автозаполнение VBA показывает ошибку:

Ошибка времени выполнения ‘1004’: сбой метода автозаполнения класса Range

Можно ли включить несколько диапазонов переменных в качестве назначения автозаполнения или любым другим способом оптимизировать мой код?

На самом деле я нашел решение, которое искал. Может быть, для кого-то это будет полезно. .AutoFill плохо работает с несколькими диапазонами, поэтому простое использование .FillDown является ответом здесь:

 Sub DragRows()

Dim LastRowEPS As Integer
Dim tr As Range

LastRowEPS = Sheet1.Cells(14, 12).End(xlDown).Row

Set tr = Sheet1.Range("A14:G" amp; LastRowEPS amp; ", I14:K" amp; LastRowEPS amp; ", M14:N" amp; LastRowEPS amp; ", P14:P" amp; LastRowEPS)
tr.FillDown

End Sub
  

Автозаполнение, Формула, заполнение

• Ниже показаны два разных подхода.
• OP уже выявил превосходное решение, которое рассматривается во второй процедуре.

Три решения (хуже: применяется к четырем диапазонам)

 Sub dragRows()
    ' Define constants.
    Const FirstRow As Long = 14
    Const LastRowCol As Long = 12
    Dim Cols As Variant
    Cols = Array("A:G", "I:K", "M:N", "P")
    ' In worksheet...
    With Sheet1
        ' Determine Rows Count.
        Dim RowsCount As Long
        RowsCount = .Cells(FirstRow, LastRowCol).End(xlDown).Row - FirstRow   1
        ' Declare variables
        Dim rng As Range
        Dim n As Long
        ' Define and fill each range.
        For n = LBound(Cols) To UBound(Cols)
            Set rng = .Columns(Cols(n)).Rows(FirstRow)
            ' Choose one of the following solutions
            rng.AutoFill Destination:=rng.Resize(RowsCount), Type:=xlFillDefault
            'rng.Resize(RowsCount).Formula = rng.Formula
            'rng.Resize(RowsCount).FillDown
        Next n
    End With
End Sub
  

Решение для заполнения (улучшенное: применяется к одному диапазону)

 Sub dragRowsFillDown()
    ' Define constants.
    Const FirstRow As Long = 14
    Const LastRowCol As Long = 12
    Dim Cols As Variant
    Cols = Array("A:G", "I:K", "M:N", "P")
    ' In worksheet...
    With Sheet1
        ' Determine Rows Count.
        Dim RowsCount As Long
        RowsCount = .Cells(FirstRow, LastRowCol).End(xlDown).Row - FirstRow   1
        ' Declare variables
        Dim rng As Range
        Dim n As Long
        ' Define (non-contiguous) range.
        For n = LBound(Cols) To UBound(Cols)
            If Not rng Is Nothing Then
                Set rng = Union(rng, .Columns(Cols(n)).Rows(FirstRow) _
                                                      .Resize(RowsCount))
            Else
                Set rng = .Columns(Cols(n)).Rows(FirstRow).Resize(RowsCount)
            End If
        Next n
    End With
    rng.FillDown
End Sub