Excel VBA : 为每一行自动生成唯一编号

Question

我需要用从某个值（比如 1000）开始的唯一数字自动填充行。

sheet 有 2 列。
每当我在每一行的第二列中填写一个值时，第一列应该会自动填写。
我填了3行(1000,1001,1002)。
现在，如果我删除自动生成值为 1001 的中间行，最初值为 1002 的行将自动更新为 1001。
但根据我的要求，该值应保持唯一（应保持为 1002）。

我使用的公式是：

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

删除值之前我的excel是这样的：

Test_Case_Id    Name
1000             a
1001             b
1002             c

删除中间一行后变成：

Test_Case_Id    Name
1000             a
1001             c

预期结果：

Test_Case_Id    Name
1000             a
1002             c

请帮帮我。

谢谢，韦韦克

Answer 1

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

不确定您是否需要宏。您可以将此宏添加到您的文件中。即使你删除了单元格，一旦你再次运行宏，当前单元格的值将是上面单元格的值加一，所以一切都会根据系列。谢谢

Answer 2

您用 VBA 标记，但您没有使用 VBA。计算行数或使用当前行号的公式将始终在 sheet re-calculcates.

时更新

为了实现您所描述的，您确实需要 VBA。一个简单的 worksheet change 事件就可以做到。按照

的思路思考

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

复制代码，right-click sheet 选项卡，select "view code" 并粘贴到代码 window 中。

这是删除 ID 为 1002 的行之前和之后的屏幕截图：

Answer 3

如果您使用以下内容创建一个唯一 ID 会怎样#

=TEXT(NOW(),"YYYYMMDD-") & TEXT(1,"0000")

20210728-0001 任务 0001 20210728-0002 任务 0002 20210728-0003 任务 0003

但是现在需要删除 0002 项

如何才能将唯一 ID # 保留在相关任务中

20210728-0001 任务 0001 20210728-0003 任务 0003

Excel VBA : 为每一行自动生成唯一编号

Excel VBA : Auto Generating Unique Number for each row

excel

vba

excel-2007

excel-2010