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

时间:2017-02-14 09:39:31

标签: excel vba excel-vba

我正在做数字生成器。我需要一个函数来查找key1的列匹配,然后检查key1和key2是否存在于该列中,如果没有,则Box2将为001.如果它确实存在,则Box2将是下一个空闲数字。 (为了更好地理解,请参见附图)

点击生成按钮后,Box2将填入正确的数字。 之后,整个生成的数字将保存到右栏中的下一个自由行。

Data sample userform

这就是我目前所拥有的:

    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

2 个答案:

答案 0 :(得分:1)

我试着用一些猜测来编写代码,因为我看不到控件的名称或者你想如何真正生成数字以及如何控制格式等等。另外,我没有源代码所以我可以调试,看看是否有任何其他问题,所以这是我能做的最好的。如果你可以让它工作,那很好,如果不是那么就把整个事情寄给我,我试着去适应它

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

答案 1 :(得分:1)

希望这可以解决您的问题,请找到excel文件number generator.xlsm

的链接