在excel中，用vba实现:在任意位置插入一行后，该行能自动复制上一行的所有公式及格式

大大白兔

在excel中，用vba实现:在任意位置插入一行后，该行能自动复制上一行的所有公式及格式

大大白兔

这里没有高手?

doitbest

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. If Target.Count <> [1:1].Columns.Count Then Exit Sub
   
3. If Application.CountIf(Target.EntireRow, "") <> [1:1].Columns.Count Then Exit Sub
   
4. If Target.Rows.Count <> 1 Then Exit Sub
   
5. If Target(1).Row = 1 Then Exit Sub
   
6. If Application.CountIf(Target.Offset(-1).EntireRow, "") = [1:1].Columns.Count Then Exit Sub
   
7. Dim ar(), i
   
8. ReDim ar(1 To Cells(Target.Offset(-1)(1).Row, Cells.Columns.Count).End(1).Column)
   
9. For i = 1 To UBound(ar)
   
10. ar(i) = Target.Offset(-1)(i).Formula
    
11. Next i
    
12. Target(1).Resize(, UBound(ar)) = ar
    
13. End Sub

复制代码

doitbest

请参考附件

大大白兔

doitbest 发表于 2012-1-18 11:18
请参考附件

我试过了，复制是能复制，但我只想复制上一行的有公式的单元格，没有公式的单元格应该空着，代码如何修改?谢谢！期待中

doitbest

请参考附件

大大白兔

doitbest 发表于 2012-1-20 17:13
请参考附件

我要的效果是，假如在第2行插入行，则b2中应该显示的是b8而不应该是b7，再插入一行，则b3中应该显示的是b9，如何修改代码?谢谢！祝龙年快乐！万事如意！！

pp9257

楼主的意思是  不用手动下拉公式  
是自动填充所有有公式的列

KCFONG

see if help you

If Target.Columns.Count <> 256 Then Exit Sub
Application.EnableEvents = False
Rows(Target.Row - 1).Copy Rows(Target.Row)
For Each c In Rows(Target.Row).Cells
     If Not c.Formula Like "=*" Then c.ClearContents
Next c
Application.EnableEvents = True
End Sub

KCFONG

Sorry I had missed 1 line

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Columns.Count <> 256 Then Exit Sub
Application.EnableEvents = False
Rows(Target.Row - 1).Copy Rows(Target.Row)
For Each c In Rows(Target.Row).Cells
     If Not c.Formula Like "=*" Then c.ClearContents
Next c
Application.EnableEvents = True
End Sub