Excel VBA UserForm，需要在每次调用表单时创建新的ID，并将其保存在“添加/保存”按钮上 [英] Excel VBA UserForm, Need to create new ID every time form is called and save it on Add/Save button click

问题描述

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

基本上我需要这样做是一旦打开/打开新的客户ID，可能是阿尔法数字集合的AA-01234，AA-01235，AA-01236等字符。

另外，是否有一种在 MsgBox 中发布新添加的客户ID以及 MsgBox添加到客户列表中的一条记录新的客户ID是

我所有尝试创建的都是失败并导致错误，我真的不明白，因为我是VBA的新手，直到现在还没有使用过。

请帮助我一点。

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

提前感谢

  Private Sub UserForm_Activate（）
 Dim iRow As Long 
 Dim ws As Workshe et 
 
设置ws = Worksheets（Customers）
 
 RefNo.Enabled = True 
'从数据库查找最后一个数据库
 iRow = ws。单元格（Rows.Count，8）.End（xlUp）.Row 
 
如果ws.Range（A& iRow）.Value =然后
 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 
 
 MsgBoxOne RECO rd添加到客户列表
 
 response = MsgBox（你要输入另一个记录吗，_ 
 vbYesNo）
 
如果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 
卸载我
 End If 
 
 End Sub 
 Private Sub Exitform_Click（）
 End 
 End Sub 
 Sub ClearFields_Click（）
对于每个ctrl In Me.Controls 
选择案例TypeName（ctrl）
案例TextBox
 ctrl.Text =
结束选择
下一步ctrl 
结束Sub 
  

解决方案

步骤1：创建命名范围

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

所以，而不是说：

 范围（客户！A8：A65536）
  

你可以把：

  Range（CustomerIDList）
  

在这张照片中，这些行被隐藏，但请注意所选范围如何称为客户IDList 。

然后，当UserForm被激活时，它将使用一个函数来返回AA-66763（比 CustomerIDList 中的最大值多一个）

步骤2：使用自定义函数拆分连字符

RegEx（正则表达式）可以让您完全控制，但这里是使用您自己定义的函数的解决方案。

此函数依赖于Excel的内置FIND（）函数，并使用VBA的Right（）和Len（）函数。

我假设以下：

• 您的工作表命名为客户


• 范围（A8）是您的值开始（与第8行第1列相同）


• 列A中的值是连续的


• 值的格式是< 01234

为了使此功能正常工作，需要五个输入（即参数）：

• sheetName


• nameOfRange


• rowStart


• colStart



• delimeterToSplitOn

  
  
  

  CustomerIDList 是我为Range选择的一个名称，但它可以是你想要的东西。

    Private Sub UserForm_Activate（）
   
   TextBox1.Value =AA-& GetCustomerId（Customers，CustomerIDList，8，1， - ）
   
   End Sub 
    

 公共功能GetCustomerId ByVal sheetName As String，ByVal nameOfRange As String，ByVal rowStart As Long，ByVal colStart As Long，ByVal delimeterToSplitOn）As Long 
 
'只需创建一个Range对象，为其分配所有的CustomerID值和命名范围
 Dim r1 As Range 
 
设置r1 =范围（Cells（rowStart，colStart），Cells（rowStart，colStart）.End（xlDown））
 
使用ActiveWorkbook.Names 
 
 .Add名称：= nameOfRange，RefersTo：==& sheetName& ！ &安培;地址& 
 
结束
 
 
'该数组包含所有原始的AlphaNumeric值
 Dim AlphaNumericArr（）As Variant 
 
 '这个数组将只保留数值
 Dim NumericArr（）As Variant 
 
 
'填充所有值的数组
 AlphaNumericArr = Range（nameOfRange）
 
'调整大小NumericArr以匹配AlphaNumeric 
'的大小注意，这是一个索引，因为行号从1 
开始ReDim NumericArr（1到UBound（AlphaNumericArr，1）） 
 
 Dim R As Long 
 Dim C As Long 
 For R = 1 To UBound（AlphaNumericArr，1）'第一个数组维是行。 
对于C = 1到UBound（AlphaNumericArr，2）'第二个数组维是列。 
 
'使用一个工作表函数：FIND（）
'使用两个VBA函数：Right（）& Len（）
 
'取原始值（即AA-123980），在连字符上分割，并将剩余的右部分分配给NumericArr 
 NumericArr（R）= Right（AlphaNumericArr ，C），Len（AlphaNumericArr（R，C）） -  Application.WorksheetFunction.Find（delimeterToSplitOn，（AlphaNumericArr（R，C））））
 
下一个C 
下一个R 
 
 
 
'现在有一个所有数值的数组，找到最大值并存储在变量
 Dim maxValue As Long 
 Dim i As Long 
 
 maxValue = NumericArr（1）
 
对于i = 1到UBound（NumericArr）
 
如果maxValue< NumericArr（i）Then 
 maxValue = NumericArr（i）
 End If 
 
下一个
 
'将1添加到maxValue，因为它会在UserForm中显示一个新的CustomerID 
 GetCustomerId = maxValue + 1 
 
 
结束函数
  

更新：

这是您如何更改现有代码，使其工作。注意，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将一条记录添加到客户列表中。新客户ID为& LastRow.Offset（1，0）.Value 
  

I have created a simple UserForm to enter new customer details to the Customer List in the spreadsheet, form works fine except for one little thing, which is New Customer ID.

Basically what I need this for to do is once form is opened/called new customer ID need to be created, which could be and Alfa numerical set of characters like AA-01234, AA-01235, AA-01236 and so on.

Also, is there a way of posting newly added Customer ID in the MsgBox along with MsgBox "One record added to Customers List. New Customer ID is "

All of my attempts to create this are failing and causing errors, which I really cannot figure out since I am new to VBA and had never used it until now.

Please help me a little.

Here is my code, Customer ID is TextBox1.

Thanks in advance

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

解决方案

Step 1: Create a Named Range

To simplify your code, I would create a NamedRange called CustomerIDList.

So, instead of saying:

    Range("Customers!A8:A65536") 

you'd be able to put:

    Range("CustomerIDList")

In this picture the rows are hidden, but notice how the range selected is called CustomerIDList.

Then, when the UserForm is activated, it will use a function to return AA-66763 (one more than the max value in CustomerIDList)

Step 2: Use a custom function to split on hyphen

RegEx (Regular Expressions) could give you full control, but here's a solution using your own defined function.

This function relies on Excel's built-in FIND() function and uses VBA's Right() and Len() functions.

I'm assuming the following:

• your Worksheet is named Customers
• Range("A8") is where your values start (same as saying row 8, column 1)
• Values in Column A are contiguous
• Format of Values is AA-01234

For this function to work, it requires five inputs (i.e. arguments):

• sheetName
• nameOfRange
• rowStart
• colStart

• delimeterToSplitOn

  CustomerIDList is a name I chose for the Range, but it could be anything you want.

  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

UPDATE:

This is how you would change your existing code so that it works. Notice, the MsgBox now shows the id, too.

    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

这篇关于Excel VBA UserForm，需要在每次调用表单时创建新的ID，并将其保存在“添加/保存”按钮上的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！