Question

我在Excel上创建了一个数据库，在尝试为每一行分配自动编号时遇到了一些问题。

要求是：

当列B不为空时，为每一行（在A列上）生成自动编号。
该数字应该是唯一的，并且必须始终连接到同一行的内容，即使列已排序或插入新行等等。
插入新行时（同一列中的任何位置），应分配一个新号码（最新号码应为最大号码）如果
可能，自动编号应该有一个前缀，编号应该以四位数字显示（例如0001,0011）

我尝试了一些我从其他人的问题中找到的VBA代码（例如Excel VBA : Auto Generating Unique Number for each row）。

到目前为止，下面的代码效果最好，但要求（3）和（4）无法通过该代码解决。

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

我缺乏对VBA的了解，我希望有人可以帮助我。非常感谢。

Answer 1

替代方法 CustomDocumentProperties

不是使用@TimWilliams 提议的隐藏表，而是可以将递增的值分配给用户定义的自定义文档属性 (CDP)，例如将其命名为"InvNo" 持有最新的发票编号。 cdp 仍然存储在保存的工作簿中。

下面的函数获取保存到此工作簿相关属性的当前数字，并通过将当前值加 1 来返回下一个数字。它使用帮助过程 RefreshCDP 来分配新值 （当然可以独立使用以编程方式将值重置为任何其他值）。 - 如果 cdp 名称未作为（可选）参数传递，则该函数默认采用 "InvNo"。

请注意，代码需要一些错误处理来检查 cdp 是否存在。

示例调用

Dim InvoiceNumber as Long
InvoiceNumber = NextNumber("InvNo")    ' or simply: NextNumber

Public Function NextNumber(Optional CDPName As String = "InvNo") As Long

    'a) get current cdp value
    Dim curVal As Long
    On Error Resume Next
    curVal = ThisWorkbook.CustomDocumentProperties(CDPName)
    If Err.Number <> 0 Then Err.Clear            ' not yet existing, results in curVal of 0

    'b) increment current cdp value by one to simulate new value
    Dim newVal As Long
    newVal = curVal + 1
    'Debug.Print "Next " & CDPName & " will be: " & newVal

    'c) assign new value to custom document property
    RefreshCDP CDPName, newVal, msoPropertyTypeNumber
    'Debug.Print "New  " & CDPName & " now  is: " & ThisWorkbook.CustomDocumentProperties(CDPName)
    NextNumber = newVal
    
End Function

帮助程序RefreshCDP

Sub RefreshCDP(CDPName As String, _
    newVal As Variant, docType As Office.MsoDocProperties)
    On Error Resume Next
    ThisWorkbook.CustomDocumentProperties(CDPName).Value = newVal
    'If cdp doesn't exist yet, create it (plus adding the new value)
    If Err.Number > 0 Then
        ThisWorkbook.CustomDocumentProperties.Add _
            Name:=CDPName, _
            LinkToContent:=False, _
            Type:=docType, _
            Value:=newVal
    End If
End Sub

相关链接

Answer 2

不要使用Max（）来查找下一个数字 - 而是使用隐藏的工作表或名称来存储当前数字，并在每次需要新ID时递增它。

例如：

Public Function NextNumber(SequenceName As String)
    Dim n As Name, v
    On Error Resume Next
    Set n = ThisWorkbook.Names(SequenceName)
    On Error GoTo 0

    If n Is Nothing Then
        'create the name if it doesn't exist
        ThisWorkbook.Names.Add SequenceName, RefersTo:=2
        v = 1
    Else
        'increment the current value
        v = Replace(n.RefersTo, "=", "")
        n.RefersTo = v + 1
    End If
    NextNumber = v
End Function

这允许您使用多个不同的序列，只要您为每个序列指定一个不同的名称。

Dim seq
seq = NextNumber("seqOne")
'etc

Excel VBA：自动编号

2 个答案: