vba - Excel VBA UserForm，每次调用表单时都需要创建新ID并将其保存在“添加/保存”按钮上单击

Question

我创建了一个简单的用户表单，用于将新客户详细信息输入电子表格中的客户列表，表单工作正常，除了一件小事，即新客户 ID。

基本上，我需要这样做的是，一旦打开表单/调用新的客户 ID，就需要创建它，这可能是 Alfa 数字字符集，如 AA-01234、AA-01235、AA-01236 等.

此外，是否有一种方法可以在 MsgBox 中发布新添加的客户 ID 以及 MsgBox“一条记录已添加到客户列表。新客户 ID 为”

我创建这个的所有尝试都失败并导致错误，我真的无法弄清楚，因为我是 VBA 新手，直到现在才使用它。

请帮我一点忙。

这是我的代码，客户 ID 是 TextBox1。

提前致谢

Private Sub UserForm_Activate()
Dim iRow As Long
Dim ws As Worksheet

    Set ws = Worksheets("Customers")

    RefNo.Enabled = True
    'find last data row from database
    iRow = ws.Cells(Rows.Count, 8).End(xlUp).Row

    If ws.Range("A" & iRow).Value = "" Then
        RefNo.Text = "TAS1"
        ws.Range("A" & iRow).Value = RefNo
    Else
        RefNo.Text = "TAS" & Val(Mid(ws.Cells(iRow, 1).Value, 4)) + 1
        ws.Range("A" & iRow + 1).Value = RefNo
    End If
    TextBox1.Value = WorksheetFunction.Max(Range("Customers!A8:A65536")) + 1
End Sub

Private Sub Addreccord_Click()
    Dim LastRow As Object

    Set LastRow = Range("Customers!A65536").End(xlUp)

    LastRow.Offset(1, 0).Value = WorksheetFunction.Max(Range("Customers!A8:A65536")) + 1
    LastRow.Offset(1, 1).Value = TextBox2.Text
    LastRow.Offset(1, 2).Value = TextBox3.Text
    LastRow.Offset(1, 3).Value = TextBox4.Text
    LastRow.Offset(1, 4).Value = TextBox5.Text
    LastRow.Offset(1, 5).Value = TextBox6.Text
    LastRow.Offset(1, 6).Value = TextBox7.Text
    LastRow.Offset(1, 7).Value = TextBox8.Text
    LastRow.Offset(1, 8).Value = TextBox9.Text
    LastRow.Offset(1, 9).Value = TextBox10.Text
    LastRow.Offset(1, 10).Value = TextBox11.Text

    MsgBox "One record added to Customers List"

    response = MsgBox("Do you want to enter another record?", _
              vbYesNo)

    If response = vbYes Then
        TextBox1.Value = WorksheetFunction.Max(Range("Customers!A8:A65536")) + 1
        TextBox2.Text = ""
        TextBox3.Text = ""
        TextBox4.Text = ""
        TextBox5.Text = ""
        TextBox6.Text = ""
        TextBox7.Text = ""
        TextBox8.Text = ""
        TextBox9.Text = ""
        TextBox10.Text = ""
        TextBox11.Text = ""

        TextBox2.SetFocus

    Else
       Unload Me
    End If

End Sub
Private Sub Exitform_Click()
    End
End Sub
Sub ClearFields_Click()
    For Each ctrl In Me.Controls
        Select Case TypeName(ctrl)
            Case "TextBox"
                ctrl.Text = ""
        End Select
    Next ctrl
End Sub

Answer 1

第 1 步:创建命名范围

为了简化您的代码，我将创建一个名为 CustomerIDList 的 NamedRange。

所以，不要说:

    Range("Customers!A8:A65536") 

你可以输入:

    Range("CustomerIDList")

在此图中，行被隐藏，但请注意所选范围如何称为CustomerIDList。

然后，当用户窗体被激活时，它将使用一个函数返回 AA-66763(比 CustomerIDList 中的最大值大一)

第 2 步:使用自定义函数按连字符分割

RegEx(正则表达式)可以为您提供完全控制，但这里有一个使用您自己定义的函数的解决方案。

该函数依赖于 Excel 的内置 FIND() 函数，并使用 VBA 的 Right() 和 Len() 函数。

我假设如下:

• 您的工作表名为“客户”
• 范围("A8") 是值的起始位置(与第 8 行第 1 列相同)
• A 列中的值是连续的
• 值的格式为AA-01234

要使该函数正常工作，需要五个输入(即参数):

• 工作表名称
• 范围名称
• 行开始
• colStart

• delimeterToSplitOn

  CustomerIDList 是我为范围选择的名称，但它可以是您想要的任何名称。

  Private Sub UserForm_Activate()
  
      TextBox1.Value = "AA-" & GetCustomerId("Customers", "CustomerIDList", 8, 1, "-")
  
  End Sub
  

    Public Function GetCustomerId( ByVal sheetName As String, ByVal nameOfRange As String, ByVal rowStart As Long, ByVal colStart As Long, ByVal delimeterToSplitOn) As Long

       'Just creating a Range object, assigning it all the values of CustomerID, and naming the Range
        Dim r1 As Range

        Set r1 = Range(Cells(rowStart, colStart), Cells(rowStart, colStart).End(xlDown))

        With ActiveWorkbook.Names

            .Add Name:=nameOfRange, RefersTo:="=" & sheetName & "!" & r1.Address & ""

        End With


        'This array holds all original AlphaNumeric Values
        Dim AlphaNumericArr() As Variant

        'This array will hold only the Numeric Values
        Dim NumericArr() As Variant


        'Populate Array with all the values
        AlphaNumericArr = Range(nameOfRange)

        'Resize NumericArr to match the size of AlphaNumeric
        'Notice, this is an index of 1 because row numbers start at 1
        ReDim NumericArr(1 To UBound(AlphaNumericArr, 1))

        Dim R As Long
        Dim C As Long
        For R = 1 To UBound(AlphaNumericArr, 1) ' First array dimension is rows.
            For C = 1 To UBound(AlphaNumericArr, 2) ' Second array dimension is columns.

                'Uses one worksheet function: FIND()
                'Uses two VBA functions: Right() & Len()

                'Taking the original value (i.e. AA-123980), splitting on the hyphen, and assigning remaining right portion to the NumericArr
                NumericArr(R) = Right(AlphaNumericArr(R, C), Len(AlphaNumericArr(R, C)) - Application.WorksheetFunction.Find(delimeterToSplitOn, (AlphaNumericArr(R, C))))

            Next C
        Next R



        'Now that have an array of all Numeric Values, find the max value and store in variable
        Dim maxValue As Long
        Dim i As Long

        maxValue = NumericArr(1)

        For i = 1 To UBound(NumericArr)

            If maxValue < NumericArr(i) Then
            maxValue = NumericArr(i)
            End If

        Next

        'Add 1 to maxValue because it will show in UserForm for a new CustomerID
        GetCustomerId = maxValue + 1


    End Function

更新:

这就是您更改现有代码以使其正常工作的方法。请注意，MsgBox 现在也显示 id。

    Private Sub Addreccord_Click()
        Dim LastRow As Object

        Set LastRow = Range("CustomerIDList").End(xlDown)

        LastRow.Offset(1, 0).Value = "AA-" & GetCustomerId("Customers", "CustomerIDList", 8, 1, "-")

        LastRow.Offset(1, 1).Value = TextBox2.Text
        LastRow.Offset(1, 2).Value = TextBox3.Text
        LastRow.Offset(1, 3).Value = TextBox4.Text
        LastRow.Offset(1, 4).Value = TextBox5.Text
        LastRow.Offset(1, 5).Value = TextBox6.Text
        LastRow.Offset(1, 6).Value = TextBox7.Text
        LastRow.Offset(1, 7).Value = TextBox8.Text
        LastRow.Offset(1, 8).Value = TextBox9.Text
        LastRow.Offset(1, 9).Value = TextBox10.Text
        LastRow.Offset(1, 10).Value = TextBox11.Text

        MsgBox "One record added to Customers List.  New Customer ID is " & LastRow.Offset(1, 0).Value