在所选范围上拖动公式

Question

寻找一种方法可以帮助我在自动填充句子的范围内拖动公式，具体取决于通过application.selection的先前选择的范围。

我被困在自动填充语句中，如下所示。

代码：

xTitleId = "KutoolsforExcel"
   Set range2 = Application.Selection
   Set range2 = Application.InputBox("Source Ranges:", xTitleId, range2.Address, Type:=8)

    Set range3 = Application.Selection
    Set range3 = Application.InputBox("Source Ranges:", xTitleId, range2.Address, Type:=8)


     range2.AutoFill Destination:=range3 'It returns "run time error 1004 autofill method of range failed

这是我想要做的背景图片......

Answer 1

你能做到吗？范围2目前是单细胞。使用FormulaR1C1来保留相对引用。

Option Explicit

Sub test()

    Dim range2 As Range
    Dim range3 As Range

    Set range2 = Application.Selection
    Set range2 = Application.InputBox("Source Ranges:", "Text", range2.Address, Type:=8)

    Set range3 = Application.Selection
    Set range3 = Application.InputBox("Source Ranges:", "Text", range2.Address, Type:=8)

    range3.Formula = range2.Formula

End Sub

FormulaR1C1的示例

Answer 2

如果角落单元格TopLeftCell和BottomRightCell作为填充范围的角落，则可以像这样填充矩形：
  

With Range(TopLeftCell, BottomRightCell)
    If .Columns.Count > 1 Then .Rows(1).FillRight 'First fill horizontally
    If .Rows.Count > 1 Then .FillDown 'Then fill vertically
End With

如果你的角落单元范围有FormulaCell和OtherCorner，那么你需要延伸检查是否填充右/左或上/下:(即确定哪个对角线和哪个方向填补）

With Range(FormulaCell, OtherCorner)
    If .Columns.Count > 1 Then 'More than 1 column, fill horizontal
        If FormulaCell.Column < OtherCorner.Column Then
            Intersect(.Cells, FormulaCell.EntireRow).FillRight
        Else
            Intersect(.Cells, FormulaCell.EntireRow).FillLeft
        End If
    End If
    If .Rows.Count > 1 Then 'More than 1 row, fill vertical
        If FormulaCell.Row < OtherCorner.Row Then
            .FillDown
        Else
            .FillUp
        End If
    End If
End With