编码生成器.xlsm

【实例简介】

通过设置相关的规则后，自动产生边啊

【实例截图】ERP编码生成器

【核心代码】

Private Sub CommandButton1_Click()
    Dim a
    a = HandleAll("编码表", 2, 14, 9, "附加属性", "-", 2, ".", 7)
    MsgBox ("ok")
End Sub
Function GetCode(PTableName As String, PCodeName As String)  '获取对应表，对应名称对应的编码
    Dim LStart As Integer
    Dim LString As String
    LString = "0"
    LStart = 2
    Do While Worksheets(PTableName).Cells(LStart, 2) <> ""
        If Worksheets(PTableName).Cells(LStart, 2) = "" Then
            Exit Do
        Else
            If Worksheets(PTableName).Cells(LStart, 2) = PCodeName Then
                LString = Worksheets(PTableName).Cells(LStart, 3)
                Exit Do
            End If
            LStart = LStart 1
        End If
    Loop
    GetCode = LString
End Function

Private Sub CommandButton2_Click()
    
    MsgBox (GetStandCode("2"))
End Sub

Function GetStandCode(PStreamCocde As String)  '根据参数码自动补齐标准位数的长度 StreamCodeLen
    Dim LTem As Integer
    Dim LNeed As Integer
    Dim LTarget As String
    LTarget = ""
    LNeed = StreamCodeLen - Len(PStreamCocde)
    For LTem = 1 To LNeed
        LTarget = LTarget & "0"
    Next
    GetStandCode = LTarget & PStreamCocde
End Function

Function GetTableMaxNum(PTableName As String, PMustStrColumn As Long)  '获取对应表的总行
    Dim LStart As Long
    LStart = CodeStart
    Do While Worksheets(PTableName).Cells(LStart, PMustStrColumn) <> ""
        If Worksheets(PTableName).Cells(LStart, PMustStrColumn) = "" Then
            Exit Do
        Else
            LStart = LStart 1
        End If
    Loop
    GetTableMaxNum = LStart
End Function

Function GetMaxNum(PSameName As String, PTableName As String, PColumn As Integer, PSplit As String, PMustStrColumn As Long) '获取对应同类的最大流水码
    Dim LMax As Long
    Dim LMaxCode As String
    LMaxCode = "1"
    For LMax = GetTableMaxNum(PTableName, PMustStrColumn) - 1 To CodeStart - 1 Step -1
        If Worksheets(PTableName).Cells(LMax, PColumn) <> "" And LMax >= CodeStart Then
            If Mid(Worksheets(PTableName).Cells(LMax, PColumn), 1, InStr(1, Worksheets(PTableName).Cells(LMax, PColumn), PSplit) - 1) = PSameName Then
                LMaxCode = Str(Val(Mid(Worksheets(PTableName).Cells(LMax, PColumn), InStr(1, Worksheets(PTableName).Cells(LMax, PColumn), PSplit) 1, CodeStart) 1))
                Exit For
            End If
        End If
    Next
    GetMaxNum = LMaxCode
End Function

Function HandleAll(PTableName As String, PMustStrColumn As Long, PCodeColumn As Integer, PAdditionColumn As Long, PTableSameStr As String, PSplit As String, PDesStart As Integer, PDesSplit As String, PDesCount As Integer)  '总过程处理
    Dim LCount As Long
    Dim LStart As Long
    Dim LCurrCode As String
    Dim LCurrDes As String
    Dim LCurrNum As String
    Dim LMerge As Integer
    LStart = CodeStart
    LCount = GetTableMaxNum(PTableName, PMustStrColumn) - 1 - CodeStart - 1
    LCurrCode = ""
    LCurrDes = ""
    Do While Worksheets(PTableName).Cells(LStart, PMustStrColumn) <> ""
        If Worksheets(PTableName).Cells(LStart, PMustStrColumn) = "" Then
            Exit Do
        Else
            If Worksheets(PTableName).Cells(LStart, PCodeColumn) = "" Then
                
                For LMerge = 1 To StreamCodeLen Step 1
                    LCurrCode = LCurrCode & GetCode(PTableSameStr & LMerge, Worksheets(PTableName).Cells(LStart, PAdditionColumn LMerge - 1))
                Next
                For LMerge = 1 To PDesCount Step 1
                    If Worksheets(PTableName).Cells(LStart, PDesStart LMerge - 1) <> "" Then
                        LCurrDes = LCurrDes & "." & Worksheets(PTableName).Cells(LStart, PDesStart LMerge - 1)
                    End If
                Next
                LCurrNum = Trim(GetMaxNum(LCurrCode, PTableName, PCodeColumn, PSplit, PMustStrColumn))
                Worksheets(PTableName).Cells(LStart, PCodeColumn) = LCurrCode & PSplit & GetStandCode(LCurrNum)
                Worksheets(PTableName).Cells(LStart, PCodeColumn 1) = Mid(LCurrDes, 2, 200)
                LCurrCode = ""
                LCurrDes = ""
            End If
            Me.TextBox2.Width = Me.TextBox1.Width / LCount * (LStart - StreamCodeLen)
            LStart = LStart 1
        End If
        DoEvents
    Loop
    HandleAll = 1
End Function