[已解决]求一个自动填充的宏

qingshui345 · 发表于 2015-10-30 15:36

求一个自动填充的宏

需求：
1.从鼠标选择的单元格开始自动向下填充，所有的内容都一样就可以，比如都填入一个“A”。
2.如果遇到非空的单元格，不填入
3.如果遇到“↑”这个符号，填充结束。

以上，求大神指教

最佳答案

月排行榜 / 总排行榜

这儿有肥猫

2015-10-30 16:39

供参考

Sub a()
Dim i&, rng
rng = ActiveCell.Value
i = ActiveCell.Row
Do Until Cells(i, 6) = "↑"
If Cells(i, 6) = "" Then
Cells(i, 6) = rng
End If
i = i + 1
Loop
End Sub

复制代码

跳转到最佳答案楼层

爱疯 · 发表于 2015-10-30 15:45

如果遇不到“↑”这个符号呢？

填充区域会不会有其他情况？比如，合并单元格。

qingshui345 · 发表于 2015-10-30 15:54

不会有合并单元格的情况，
“↑”这个符号也就是让宏停止用的，因为要填充的行数是不固定的，当然有其他好方法也好的。

wp8680 · 发表于 2015-10-30 16:27

Private Sub Worksheet_Change(ByVal Target As Range)
Dim k&, rg As Range, m&
If Target.Cells(1, 1).Value = "" Then Exit Sub
If Target.End(xlDown).Row = Cells.Rows.Count Then Exit Sub
Application.EnableEvents = False '表示禁用事件
Set rg = Target.Cells(1, 1)
m = Cells(Cells.Rows.Count, rg.Column).End(xlUp).Row
k = rg.Row
Do
k = k + 1
If rg.Offset(k, 0) = "↑" Then Exit Do
If rg.Offset(k, 0) = "" Then
rg.Offset(k, 0) = rg.Value
End If
Loop While k <= m
Application.EnableEvents = True '表示不禁用事件
End Sub

复制代码

爱疯 · 发表于 2015-10-30 16:28

最简单的做法：循环判断要填充区域，只要是空白单元格，就填上"A"

但你还是没明确填充到哪儿结束，遇不到这符号怎么办，所以无法在没确定需求的情况下写代码。

建议上传附件，好明白需求。

这儿有肥猫 · 发表于 2015-10-30 16:39

供参考

Sub a()
Dim i&, rng
rng = ActiveCell.Value
i = ActiveCell.Row
Do Until Cells(i, 6) = "↑"
If Cells(i, 6) = "" Then
Cells(i, 6) = rng
End If
i = i + 1
Loop
End Sub

复制代码

雨吧 · 发表于 2015-10-30 16:39

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
Dim x%, y%
x = Target.Row: y = Target.Column
Do While Cells(x, y) <> "↑"
If Cells(x, y) = "" Then Cells(x, y) = "A"
x = x + 1: If x > 65535 Then Exit Do
Loop
Application.EnableEvents = True
End Sub

复制代码

qingshui345 · 发表于 2015-10-30 17:11

@wp8680:
谢谢^_^，不过为什么运行的时候会报错呀？

@爱疯：
>最简单的做法：循环判断要填充区域，只要是空白单元格，就填上"A"
>但你还是没明确填充到哪儿结束，遇不到这符号怎么办，所以无法在没确定需求的情况下写代码。
>建议上传附件，好明白需求。
⇒想在Excel加一个小工具，因为要用的Excel还没做出来，所以没有具体例子。
如果遇不到这符号可能会死循环吧，本来想靠认为控制的，确保符号一定出现，
不过也可以做成循环2千次后自动停止什么的，因为要自动填充的一定有几千个。
以上，谢谢。

		自动登录	找回密码
密码			注册