问题描述
伙计们!我有一项任务是根据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自动填充后,它显示错误:
是否可以包含多个可变范围作为自动填充的目的地?或其他任何方式来优化我的代码?
解决方法
实际上,我找到了所需的解决方案。也许对某人有帮助。 .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