[已解决]求两个自动填充的宏代码

星光男孩

根据每个表的A列有内容的行，在指定列填入内容


谢谢了
Book1.rar (2.83 KB, 下载次数: 47)

2012-11-23 00:32 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2012-11-23 14:24

1. Sub 填充2()
   
2.     Dim irow&
   
3.     Dim rg As Range
   
4.     On Error Resume Next
   
5.     Application.ScreenUpdating = False
   
6.     irow = Range("a" & Rows.Count).End(xlUp).Row
   
7.     If irow <= 1 Then Exit Sub
   
8.     Set rg = Range("a2:a" & irow).SpecialCells(xlCellTypeConstants)
   
9.     If rg Is Nothing Then Exit Sub
   
10.     rg.Offset(, 1) = "OK"
    
11.     Set rg = Nothing
    
12.     Application.ScreenUpdating = True
    
13. End Sub

复制代码

跳转到最佳答案楼层

hwc2ycy

第1个问题：

1. Sub 填充1()
   
2.     Dim irow&
   
3.     Application.ScreenUpdating = False
   
4.     If Len(Range("c2").FormulaR1C1) = 0 Then Exit Sub
   
5.     irow = Range("b" & Rows.Count).End(xlUp).Row
   
6.     If irow <= 2 Then Exit Sub
   
7.     Range("c2").AutoFill Range("c2:c" & irow)
   
8.    Application.ScreenUpdating = True
   
9. End Sub

复制代码

hwc2ycy

第2个问题：

1. Sub 填充2()
   
2.     Dim irow&
   
3.     Application.ScreenUpdating = False
   
4.     irow = Range("b" & Rows.Count).End(xlUp).Row
   
5.     If irow <= 1 Then Exit Sub
   
6.     Range("a2:a" & irow).SpecialCells(xlCellTypeConstants).Offset(, 1) = "OK"
   
7.     Application.ScreenUpdating = True
   
8. End Sub

复制代码

hwc2ycy

调用代码的时候请注意当前活动工作表。放哪里还是有要求的。

hwc2ycy

上午在外面办事的时候，突然想到，程序没能考虑到容错。再来改下。

hwc2ycy

1. Sub 填充2()
   
2.     Dim irow&
   
3.     Dim rg As Range
   
4.     On Error Resume Next
   
5.     Application.ScreenUpdating = False
   
6.     irow = Range("a" & Rows.Count).End(xlUp).Row
   
7.     If irow <= 1 Then Exit Sub
   
8.     Set rg = Range("a2:a" & irow).SpecialCells(xlCellTypeConstants)
   
9.     If rg Is Nothing Then Exit Sub
   
10.     rg.Offset(, 1) = "OK"
    
11.     Set rg = Nothing
    
12.     Application.ScreenUpdating = True
    
13. End Sub

复制代码

glqglq

没看懂，继续学习