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

时间:2014-03-07 13:18:36

标签: vba excel-vba excel

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

基本上我需要做的就是一旦打开/调用表单需要创建新的客户ID,这可能和Alfa数字设置的字符如AA-01234,AA-01235,AA-01236等等

此外,还有一种方法可以在MsgBoxMsgBox "One record added to Customers List. New Customer ID is "

中发布新添加的客户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

2 个答案:

答案 0 :(得分:2)

第1步:创建命名范围

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

所以,而不是说:

    Range("Customers!A8:A65536") 

你可以把:

    Range("CustomerIDList")


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

excel named range


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

excel userform


第2步:使用自定义功能拆分连字符

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

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

我假设以下内容:

  • 您的工作表名为Customers
  • 范围(“A8”)是您的值开始的地方(与第8行第1列相同)
  • A列中的值是连续的
  • 值的格式为 AA-01234


要使此功能起作用,它需要五个输入(即参数):

  • SHEETNAME
  • nameOfRange
  • rowStart
  • colStart
  • delimeterToSplitOn

    CustomerIDList 是我为Range选择的名称,但它可以是您想要的任何名称。

    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

答案 1 :(得分:0)

我缩短了你的代码。我认为你的问题出在Addreccord_Click() sub。这对你有用吗?

Private Sub CommandButton1_Click()
Dim LastRow As Range

    Set LastRow = Range("A8").End(xlDown)
    LastRow.Offset(1, 0).Value = WorksheetFunction.Max(Range("Customers!A8:A65536")) + 1
    LastRow.Offset(1, 1).Value = TextBox1.Text

    MsgBox "One record added to Customers List"

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

    If response = vbYes Then

    Else
        Unload Me
    End If
End Sub