[已解决]如何使表格剩一行时自动增加1行，并复制上一行的格式和公式

七彩屋

自动增加1行，但不能复制上一行的公式，求帮助。





客户明细帐.rar (52.31 KB, 下载次数: 22)

2014-3-8 18:14 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

fffox

2014-3-8 19:33

一定要自动添加公式也可以，在你的代码中加了几句：

1. Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
   
2.     Dim rng As Range
   
3.     Set rng = Columns("G:H").Find(what:="货款加运费总计")
   
4.     If Target.Column <> 4 Or Target.Count > 1 Or Target.Row < 6 Or Target.Row > rng.Row Then
   
5.         Exit Sub
   
6.     Else
   
7.         If Target.Row - rng.Row = -3 Then
   
8.             Rows(rng.Row - 2).Insert
   
9.             Target.Offset(0, 3).Copy
   
10.             Target.Offset(1, 3).PasteSpecial xlPasteFormulas
    
11.             Target.Offset(0, 1).Select
    
12.         End If
    
13.     End If
    
14. End Sub
    

复制代码

跳转到最佳答案楼层

問天

学习，帮顶

那么的帅

不需要公式，输入 数量 和 单价后 ，自动得出 金额

fffox

一定要自动添加公式也可以，在你的代码中加了几句：

1. Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
   
2.     Dim rng As Range
   
3.     Set rng = Columns("G:H").Find(what:="货款加运费总计")
   
4.     If Target.Column <> 4 Or Target.Count > 1 Or Target.Row < 6 Or Target.Row > rng.Row Then
   
5.         Exit Sub
   
6.     Else
   
7.         If Target.Row - rng.Row = -3 Then
   
8.             Rows(rng.Row - 2).Insert
   
9.             Target.Offset(0, 3).Copy
   
10.             Target.Offset(1, 3).PasteSpecial xlPasteFormulas
    
11.             Target.Offset(0, 1).Select
    
12.         End If
    
13.     End If
    
14. End Sub
    

复制代码

七彩屋

fffox 发表于 2014-3-8 19:33
一定要自动添加公式也可以，在你的代码中加了几句：

谢谢fffox老师
这样会有一个选择框，比原来没有好一点，数据输入不容易出错。

linwei417

想下载附件观摩学习，竟然无法下载