Excel VBA : Auto Generating Unique Number for each row

我的未来我决定 提交于 2019-12-30 14:25:11

问题


I got a requirement for auto filling the row with unique number starting from some value(say 1000).

  • The sheet has 2 columns.

  • When ever I fill a value in 2nd column in each row the first column should auto filled.

  • I have filled 3 rows(1000,1001,1002).

  • Now if i delete the middle row that has the auto generated value as 1001, the row that was initially with the value 1002 gets automatically updated to 1001.

  • But according to my requirement the value should remain unique(it should remain as 1002).

Formula that i used is:

=IF(B2<>"",COUNTA($B$2:B2)+999,"")

My excel is like this before deleting the value:

Test_Case_Id    Name
1000             a
1001             b
1002             c

After deleting the middle row it becomes:

Test_Case_Id    Name
1000             a
1001             c

Expected Result:

Test_Case_Id    Name
1000             a
1002             c

Please help me in this.

Thanks, Vevek


回答1:


You tagged with VBA, but you are not using VBA. Formulas that count rows or use the current row number will always update when the sheet re-calculcates.

In order to achieve what you describe, you really need VBA. A simple worksheet change event should do it. Think along the lines of

Private Sub Worksheet_Change(ByVal Target As Range)
Dim maxNumber
If Not Intersect(Target, Range("B:B")) Is Nothing Then
' don't run when more than one row is changed
    If Target.Rows.Count > 1 Then Exit Sub
' if column A in the current row has a value, don't run
    If Cells(Target.Row, 1) > 0 Then Exit Sub
' get the highest number in column A, then add 1 and write to the
' current row, column A
    maxNumber = Application.WorksheetFunction.Max(Range("A:A"))
    Target.Offset(0, -1) = maxNumber + 1
End If
End Sub

Copy the code, right-click the sheet tab, select "view code" and paste into the code window.

Here's a screenshot of before and after deleting row with ID 1002:




回答2:


Sub abc()
Dim a As Integer
Dim b As Integer
Dim i As Integer
Dim z As Integer

i = 1
Set sh = ThisWorkbook.Sheets("Sheet1") 'instead of sheet1 you can add name of your sheet
Dim k As Long
k = 2
Set rn = sh.UsedRange
k = rn.Rows.Count

Cells(1, 1).Value = 1001


Do Until i = k

b = (Cells(i, 1).Value)
a = b + 1
i = i + 1

Cells(i, 1).Value = a

Loop
End Sub

Not sure if you need a macro. You can add this macro to your file. Even after you delete the cell, once you run again the macro, the current cell value will be the value of the above cell plus one, so everthing will be according to series. Thanks



来源:https://stackoverflow.com/questions/34987185/excel-vba-auto-generating-unique-number-for-each-row

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!