VBA，在有空单元格的地方向下拖动公式

Question

这是我在 Sheet1 中的示例，（从 B 到 F 的数字只是 =Sheet2！B2种公式）

A           B   C   D   E   F
11/12/2016  300 4   4   3   85
12/12/2016  23  4   4   2   87
13/12/2016  21  4   4   2   79
14/12/2016  67  4   4   4   76

我试图在 A 列下方插入接下来 7 天的日期（我已经实现了），并因此将公式从 B 列拖到 F。我无法使用 RANGE B1：F7，因为后一周我将在旧的 7 天数据中附加新的数据，所以我需要动态范围。

这是我的尝试，但是我返回 for 循环中的 inRange 合并（错误 = 范围 ob object_global失败）：

Sub test()
    Dim r As Range Set r = Intersect(ActiveSheet.UsedRange,   Range("A:A")).Cells.SpecialCells(xlCellTypeBlanks)
    r(1).Formula = "=Today()"
    r(2).Formula = "=Today()+1"
    r(3).Formula = "=Today()+2"
    r(4).Formula = "=Today()+4"
    r(5).Formula = "=Today()+5"
    r(6).Formula = "=Today()+6"
    Dim inRange As Range
    Set inRange = Sheets("Sheet1").Range("B" & i & ":" & "F" & i)
    For i = 1 To 7
         Sheets("Sheet1").Range("B1:F1").Select
        Selection.AutoFill Destination:=Range(inRange), Type:=xlFillDefault
    Next i
End Sub

谢谢

Answer 1

我不会使用这个：

Set r = Intersect(ActiveSheet.UsedRange, Range("A:A")).Cells.SpecialCells(xlCellTypeBlanks)

因为如果交集没有返回单元格，则会引发错误。如果此表是Sheet1中的唯一范围，则可以出于性能和文件大小考虑删除某些行。

如果范围（B1，F1）中的公式没有变化，我会这样编码：

Sub test()
    Dim r As Excel.Range
    Dim i As Integer
    'I wouldn't use this
    'Set r = Intersect(ActiveSheet.UsedRange, Range("A:A")).Cells.SpecialCells(xlCellTypeBlanks)
    'Instead:
    Range("A1").End(xlDown).Offset(1, 0).Activate
    ActiveCell.Formula = "=Today()"
    For i = 0 To 6
        If i = 0 Then
            ActiveCell.Formula = "=Today()"
        Else
            ActiveCell.Formula = "=Today()+" & i
        End If
        ActiveCell.Offset(1, 0).Activate
    Next i
    Range("B1:F1").Copy Intersect(ActiveSheet.UsedRange, Range("B:F")).Cells.SpecialCells(xlCellTypeBlanks)
End Sub

Answer 2

也许不是世界上最好的代码，但它很快，因为它避免了循环（假设我理解了这个问题）：

Sub testit(cell as range, numberOfRows as long)
    range(cell, cell.Offset(numberOfRows)).formula = "=Today() + row() - " & cell.Row
End Sub

编辑：再三考虑，我想我误解了。这样更好吗？

Sub testit()
    Dim k as range
    Set k = Range("B2").CurrentRegion.columns(1).SpecialCells(xlCellTypeBlanks)
    k.formula = "=Today() + row() - " & k.cells(1,1).Row
End Sub

请记住复制并粘贴为值，假设您希望数据保持这种状态。否则它也是动态的！