用于生成顺序范围的代码

Question

我有一个用户表单，其图像位于下方。

我需要的是当我打开用户表单时，应该有凭号#textbox的序号。

例如，

。 B列的值为BPV / 1，BPV / 2，BPV / 3。 我需要的是当我运行userform时，凭证#textbox应显示下一个序列号，即BPV / 4等等......

以下是我的代码。

Private Sub UserForm_Initialize()
Dim NextNum As Long, prefix As String
Dim i As Long

prefix = "BPV/"
NextNum = Application.WorksheetFunction.Max(Worksheets("Sheet1").Columns(2))
i = NextNum + 1

Me.TextBox2.Enabled = False
Me.TextBox2.Value = prefix & i

End Sub

请仔细阅读代码并告知如何实现它。

由于 萨勒曼汗

Answer 1

为了在B列中找到包含Max s的String值，我正在将字符串读入Long类型的数组中（如果你有非常大的话）数字），使用Mid函数。之后，我可以在数组中找到Max值。

使用Mid功能进行传输，使用以下行：

myArr(lRow) = CLng(Mid(.Cells(lRow, 2), 5))

值5由Len(prefix) +1

计算

<强>代码

Option Explicit

Private Sub UserForm_Initialize()

Dim NextNum As Long, prefix As String
Dim LastRow As Long, lRow As Long
Dim myArr() As Long

prefix = "BPV/"

With Sheets("Sheet1")
    'find last row with data in Column B
    LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row

    ReDim myArr(2 To LastRow)
    ' read all cells contents and convert them to array of numbers
    ' start from 2nd row , 1st row has headers
    For lRow = 2 To LastRow
        If Mid(.Cells(lRow, 2), 5) <> "" Then
            myArr(lRow) = CLng(Mid(.Cells(lRow, 2), 5))
        End If
    Next lRow

    ' find maximum value in array
    NextNum = WorksheetFunction.Max(myArr)
End With

Me.TextBox2.Enabled = False
Me.TextBox2.Value = prefix & NextNum + 1

End Sub

Answer 2

您可以在FormulaArray中输入此Sheet1，在A1中说：

=MAX(VALUE(SUBSTITUTE(B:B,"BPV/","")))

然后让这一行指向那个单元格：

NextNum = Worksheets("Sheet1").Range("A1").value2

• 同时按* [Ctrl] + [Shift] + [Enter] 输入FormulaArrays，您将看到 { 和 } 围绕公式

Answer 3

此解决方案使用Application.Evaluate Method (Excel)一次获取最后一张优惠券号码，避免使用For...Next。它还使用常量（Const）来保存前缀和MAX公式。

Private Sub UserForm_Initialize_EEM_Publish()
Const kPrefix As String = "BPV/"
Const kFml As String = "=MAX(IFERROR(1" & _
    "*VALUE(SUBSTITUTE(#rTrg,""#Prefix"",""""))" & _
    "*(SEARCH(""#Prefix"",#rTrg)),0))"
Dim rTrg As Range, sFml As String
Dim lNextNum As Long, l As Long

    Rem Get Last Voucher Number
    With ThisWorkbook.Worksheets("Sheet1").Columns("B")
        Set rTrg = .Cells(1).Resize(.Cells(.Rows.Count).End(xlUp).Row)
    End With
    sFml = kFml
    sFml = Replace(sFml, "#Prefix", kPrefix)
    sFml = Replace(sFml, "#rTrg", rTrg.Address(, , , 1))
    lNextNum = Application.Evaluate(sFml)

    Rem Set Next Voucher Number
    l = 1 + lNextNum
    Me.TextBox2.Enabled = False
    Me.TextBox2.Value = sPrefix & i

End Sub