我创建了一个简单的UserForm,用于在电子表格中向客户列表输入新的客户详细信息,表单工作正常,除了一件小事,即新客户ID。
基本上我需要做的就是一旦打开/调用表单需要创建新的客户ID,这可能和Alfa数字设置的字符如AA-01234,AA-01235,AA-01236等等
此外,还有一种方法可以在MsgBox
和MsgBox "One record added to Customers List. New Customer ID is "
我创建这个的所有尝试都失败并导致错误,我真的无法理解,因为我刚接触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
答案 0 :(得分:2)
第1步:创建命名范围
为了简化代码,我将创建一个名为 CustomerIDList 的NamedRange。
所以,而不是说:
Range("Customers!A8:A65536")
你可以把:
Range("CustomerIDList")
在此图片中,行被隐藏,但请注意所选范围如何称为 CustomerIDList 。
然后,当UserForm被激活时,它将使用一个函数返回AA-66763(比 CustomerIDList 中的最大值多一个)
第2步:使用自定义功能拆分连字符
RegEx(正则表达式)可以让您完全控制,但这是使用您自己定义的函数的解决方案。
此函数依赖于Excel的内置FIND()函数,并使用VBA的Right()和Len()函数。
我假设以下内容:
要使此功能起作用,它需要五个输入(即参数):
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