Vba计数(能否达到如下效果)如图

Vba计数(能否达到如下效果)如图

B列任意位置输入任意数,可同时向上、向下计数(90数内)如:输入4,可同时向上、向下计数4、14、24、34、44、54、64、74、84、94;又如输入7,可同时向上、向下计数7、17、27、37、47、57、67、77、87、97.如图:


beyond_aj 1年前 已收到1个回答 举报

娃哈哈o55183 幼苗

共回答了21个问题采纳率:100% 举报

试试
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 2 Then Exit Sub
If IsNumeric(Target.Value) = False Then Exit Sub
Dim iNum&, iRow&, iCount%
iNum = Target.Value
If iNum > 10 Then Exit Sub
iRow = Target.Row
iCount = 1
Application.EnableEvents = False
Cells(iRow + iNum - 1, 2) = iNum
Cells(iRow - iNum + 1, 2) = iNum
Do
If iRow - iNum - iCount * 10 > 0 Then Cells(iRow - iNum + 1 - iCount * 10, 2) = iNum + iCount * 10
If iRow + iNum + iCount * 10 < Rows.Count Then Cells(iRow + iNum - 1 + iCount * 10, 2) = iNum + iCount * 10
iCount = iCount + 1
Loop Until iCount > 9
Application.EnableEvents = True
End Su

1年前 追问

1

beyond_aj 举报

谢谢老师,达到效果,如想调整在w列,如何改动代码。

举报 娃哈哈o55183

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 23 Then Exit Sub
If IsNumeric(Target.Value) = False Then Exit Sub
Dim iNum&, iRow&, iCount%
iNum = Target.Value
If iNum > 10 Then Exit Sub
iRow = Target.Row
iCount = 1
Application.EnableEvents = False
Cells(iRow + iNum - 1, 23) = iNum
Cells(iRow - iNum + 1, 23) = iNum
Do
If iRow - iNum+1 - iCount * 10 > 0 Then Cells(iRow - iNum + 1 - iCount * 10, 23) = iNum + iCount * 10
If iRow + iNum-1 + iCount * 10 < Rows.Count Then Cells(iRow + iNum - 1 + iCount * 10, 23) = iNum + iCount * 10
iCount = iCount + 1
Loop Until iCount > 9
Application.EnableEvents = True
End Sub
可能相似的问题
Copyright © 2024 YULUCN.COM - 雨露学习互助 - 17 q. 0.041 s. - webmaster@yulucn.com