VBA-在子字符串和范围中查找的数字生成器

Question

I am doing number generator. I need a function to find the column match of key1 then check if key1 and key2 exist in that column, if not then Box2 will be 001. If it does exist, then Box2 will be the next free number. (See attached image for better understanding)

Box2 will be filled with right number after click to GENERATE button. After that whole generated number is saved to next free row in right column.

This is what I currently have:

    Private Sub CommandButton1_Click()

        Dim FindRng As Range
        Dim col As Long
        Dim wb As Workbook

        Set wb = Workbooks.Open("U:\DB_DATA\DB_NUMBERS.xlsx")       
        With wb.Sheets("List1")
            Set FindRng = .Range("A1:ZZ1").Find(What:=Box1.Text, LookIn:=xlValues, LookAt:=xlWhole, _
                           MatchCase:=False, SearchFormat:=False)


            If Not FindRng Is Nothing Then             
               col = FindRng.Column            
            Else
            End If
        End With

        BoxMain.Value = Box1.Value & "_" & Box2.Value & "_" & Box3.Value & "_" & Box4.Value & "_" & Box5.Value

    End Sub

Answer 1

I tried to write the code with some guesses since I cannot see the name of the controls or how you want to really generate the numbers and how to control the format etc. Also, I did not have the source code so that i can debug and see if there is any other problem, so this is the best I could do. If you can get it working, great, if not then send me the whole thing and I try to fit it

Private Sub CommandButton1_Click()
    Dim chk As Boolean
    Dim FindRng As Range
    Dim col As Long
    Dim wb As Workbook
    Dim ws As Worksheet

    Set wb = Workbooks.Open("U:\DB_DATA\DB_NUMBERS.xlsx")
    Set ws = wb.Sheets("List1")

    With ws
        Set FindRng = .Range("A1:ZZ1").Find(What:=Box1.Text, LookIn:=xlValues, LookAt:=xlWhole, _
                       MatchCase:=False, SearchFormat:=False)


        If Not FindRng Is Nothing Then
           chk = True
           col = FindRng.Column 'column with key1 value found, now find key2 in cells

           'Check if there is any number in the column
           Dim i As Integer
           Dim lRow As Integer
           Dim key2 As String
           Dim strSequence As String
           Dim rng As Range

           key2 = Box3.Text
           strSequence = "001" 'start with this unless we find a higher number in cells

           'find the last row with data in the column
           lRow = LastRowInColumn(ws, col)

           'numbers are written starting from row 2, so if lRow is 2 there is no number and sequence starts from 001
           If lRow <= 2 Then
                strSequence = "001"
                'Box2.Text="001" ??? I don't know the name of the textbox for sequence
           Else 'get the sequence from last row
                 Dim str As String
                 Dim arr() As String
                 For i = 2 To lRow
                    arr = Split(, "_") 'split the values of cells
                    str = Replace(arr(2), Box4.Text, "")
                    If str = key2 Then 'this is a match, check for the sequence
                        If str > strSequence Then
                        strSequence = str
                    End If
                 Next i

                 'At this point, strSequence should be the last sequence assigned, so we add one
                 strSequence = Format(CInt(strSequence) + 1, "000")
                 Box2.Text = "001"
           End If

        Else
            chk = False
            MsgBox "key 1 does not exist."
        End If
    End With

    BoxMain.Value = Box1.Value & "_" & Box2.Value & "_" & Box3.Value & "_" & Box4.Value & "_" & Box5.Value

End Sub

Function LastRowInColumn(Optional sh As Worksheet, Optional colNumber As Long = 1) As Long
    'Finds the last row in a particular column which has a value in it
    If sh Is Nothing Then
        Set sh = ActiveSheet
    End If
    LastRowInColumn = sh.Cells(sh.Rows.Count, colNumber).End(xlUp).Row
End Function

Answer 2

希望这可以解决您的问题，请找到此链接以获取excel文件编号generator.xlsm