2017-01-23 106 views
0

这是我在Sheet1样品,(从B至F号只是= Sheet2的!B2这种公式)VBA,拖累公式那里有空白单元格

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天的日期(已经达到了II),并将公式从B栏拖到F处。我不能使用RANGE B1:F7,因为我将在7天后追加新的数据,所以我需要动态范围。

这里是我的尝试,但是我在上INRANGE concatentation返回环路(错误=范围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 

感谢

回答

0

我不会用这样的:

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 
+1

感谢,它确实work.However我想明白你为什么建议不要使用这个:Set r = Intersect(ActiveSheet.UsedRange,Range(“A:A”))。Cells.SpecialCells(xlCellTypeBlanks)。谢谢! – Vincenzo

+0

@Vincenzo当我测试该代码行时,我复制了您提供的表格,因此UsedRange中没有空白单元格。这导致VBA发出错误,因为它无法在交集中找到任何xlCellTypeBlanks。因此,如果您有任何空白单元格低于该范围,则应该删除那些行(如果有很多)(Ctrl + End查找使用范围中的最后一个单元格)。如果有许多空白行,并且您消除了它们,文件大小将会减少,并且性能会更好(计算时间更少)。 –

0

也许不是世界上最好的代码,但很快,因为它避免了环路(假设我理解的问题):

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 

记住要复制并粘贴为值,假设您希望数据保持这种方式。否则,它也将是动态的!