每隔一行自動遞增一次序號,並自動統計個數

[M_Judy0]

例如:當我在A4欄內輸入編號之後,就會自動向下每隔一行遞增100個序號,且從B4欄起會自動顯示序號的個數,如附件所示,用VBA如何實現.謝謝!
如
A欄 B欄
A4=001 1
A5=001 2
A6=002 1
A7=002 2
A8=003 1
A9=003 2
......

[dragonrabb]

Sub test()
Dim a As String
a = InputBox("请输入起始号码", "输入", "001")
For i = 0 To 198 Step 2
Cells(4 + i, 1) = a
Cells(5 + i, 1) = a
If i < 198 Then
Cells(5 + i, 1).AutoFill Destination:=Range(Cells(5 + i, 1), Cells(6 + i, 1)), Type:=xlFillSeries
a = Cells(6 + i, 1)
End If
For H = 0 To 1
Cells(4 + i + H, 2) = H + 1
Next
Next
End Sub
把上面代码输入新建的模块中，然后运行宏

[novelty2007]

通过Excel的事件响应sub，实现自动执行。其中通过Target 参数得到的是输入数据的单元格。Target.Row可以得到对应的行号。后面的程序可以参照上面的代码。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub

[M_Judy0]

謝謝1.2樓的回複.
我測試了程式,發現只能遞增到99,為什麽不能改為100位數以上呢.需改哪一個地方即可
如程式改成2樓所講的話,不論在A4或其它地方只要輸入起始序號,程式就能自動遞增三到四位數,應如何實現.謝謝!

[dragonrabb]

Sub test()
Dim a As String
Dim b As Integer
Dim c As Integer
b = ActiveCell.Row
c = ActiveCell.Column
a = InputBox("请输入起始号码", "输入", "001")

For i = 0 To 198 Step 2
Cells(b + i, c) = a
Cells(b + 1 + i, c) = a
If i < 198 Then
Cells(b + 1 + i, c).AutoFill Destination:=Range(Cells(b + 1 + i, c), Cells(b + 2 + i, c)), Type:=xlFillSeries
a = Cells(b + 2 + i, c)
End If
For H = 0 To 1
Cells(b + i + H, c + 1) = H + 1
Next
Next
End Sub
要得到100以后的数，自己改198这个数

[send068]

帮顶