Excel VBA从范围中拖动带有多个变量的公式，错误1004

如何解决Excel VBA从范围中拖动带有多个变量的公式，错误1004

伙计们！我有一项任务是根据1个特定列的长度（长度可以变化）将公式拖动到几列中。我设法做到了，但是必须为每个范围创建新的代码行，以下是我的变体1的示例：

Sub DragRows()
    
Dim LastRowEPS As Integer
Dim tr As Range

Set tr = Range("A14:G" & LastRowEPS)

Range("A14:G14").Select
Selection.AutoFill Destination:=tr,Type:=xlFillDefault

Set tr = Range("I14:K" & 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" & LastRowEPS & ",I14:K" & LastRowEPS & ",M14:N" & LastRowEPS & ",P14:P" & LastRowEPS)

Range("A14:G14,I14:K14,M14:N14,P14:P14").Select
Selection.AutoFill Destination:=tr,Type:=xlFillDefault

End Sub

选择过程运行良好，并且tr.Range定义正确，但是在我要求VBA自动填充后，它显示错误：

运行时错误'1004'：Range类的自动填充方法失败

是否可以包含多个可变范围作为自动填充的目的地？或其他任何方式来优化我的代码？

仅供参考：变体1正常运行，变体2显示错误

解决方法

实际上，我找到了所需的解决方案。也许对某人有帮助。 .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" & LastRowEPS & ",I14:K" & LastRowEPS & ",M14:N" & LastRowEPS & ",P14:P" & LastRowEPS)
tr.FillDown

End Sub

,

自动填充，公式，FillDown

• 下面显示了两种不同的方法。
• 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",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