如何获得带有不同前缀的下一个序列号？

Question

我正在制作一个自动产品SKU创建者Excel表。我有一个问题：该程序根据从下拉列表中选择的选项生成SKU，并为所选的每个列表项添加一个数字。我设法使它正常工作，但是SKU中的后4位数字对于每个商品来说都是唯一的。创建唯一编号是我遇到的问题。我在表格中列出了这样的SKU

程序在表底部添加一个新的SKU。从列表中选择之后，有五个数字，例如01123。程序应检查以相同的5位数字开头的数字中的下一个“免费”序列号是什么。就像已经有011230001，下一个SKU将自动关联到011230002，如果已经有011330001，它将自动关联到011330002。因此，每个项目都有唯一的SKU。我该怎么做？

获得前两个数字的代码：

Sub kopioi1()
If Range("A2") = "Tietokoneet" Then
    eRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Cells(eRow, 1).Value = "01"
 ElseIf Range("A2") = "Komponentit" Then
    eRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Cells(eRow, 1).Value = "02"
 ElseIf Range("A2") = "Oheislaite" Then
    eRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Cells(eRow, 1).Value = "03"
 ElseIf Range("A2") = "Ohjelmisto" Then
    eRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Cells(eRow, 1).Value = "04"
 ElseIf Range("A2") = "Verkko" Then
    eRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Cells(eRow, 1).Value = "05"
 ElseIf Range("A2") = "Mobiililaite" Then
    eRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Cells(eRow, 1).Value = "06"
 ElseIf Range("A2") = "Tarvikkeet" Then
    eRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Cells(eRow, 1).Value = "07"
 ElseIf Range("A2") = "Palvelu" Then
    eRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Cells(eRow, 1).Value = "08"
End If
End Sub

第三个数字：

Sub kopioi2()
If Range("B2") = "Kannettavat" Then
Cells.Find(What:="01", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=True).Activate
ActiveCell.Value = ActiveCell.Value & "1"

 ElseIf Range("B2") = "Pöytäkoneet" Then
Cells.Find(What:="01", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=True).Activate
ActiveCell.Value = ActiveCell.Value & "2"

 ElseIf Range("B2") = "Käytetyt" Then
Cells.Find(What:="01", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=True).Activate
ActiveCell.Value = ActiveCell.Value & "3"

End If
End Sub

第四个数字：

Sub kopioi3()
If Range("C2") = "_13" Then
Cells.Find(What:="011", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=True).Activate
ActiveCell.Value = ActiveCell.Value & "1"

 ElseIf Range("C2") = "_14" Then
Cells.Find(What:="011", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=True).Activate
ActiveCell.Value = ActiveCell.Value & "2"

 ElseIf Range("C2") = "_15.6" Then
Cells.Find(What:="011", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=True).Activate
ActiveCell.Value = ActiveCell.Value & "3"

 ElseIf Range("C2") = "_17" Then
Cells.Find(What:="011", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=True).Activate
ActiveCell.Value = ActiveCell.Value & "4"

 ElseIf Range("C2") = "Yrityskannettavat" Then
Cells.Find(What:="011", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=True).Activate
ActiveCell.Value = ActiveCell.Value & "5"

End If
End Sub

第五个数字和最后四个数字：

Sub kopioi4()
Dim cell As Range
Dim bottomA As Integer
Dim data_text As String

bottomA = Range("a" & Rows.Count).End(xlUp).Row
Dim rng As Range
Set rng = Range("A1:A" & bottomA)
If Range("D2") = "Acer" Then
    For Each cell In rng
        If Len(cell) = 4 Then
            cell.Value = cell.Value & "1"
        End If
    Next cell

 ElseIf Range("D2") = "Apple" Then
    For Each cell In rng
        If Len(cell) = 4 Then
            cell.Value = cell.Value & "2"
        End If
    Next cell

 ElseIf Range("D2") = "ASUS" Then
    For Each cell In rng
        If Len(cell) = 4 Then
            cell.Value = cell.Value & "3"
        End If
    Next cell

 ElseIf Range("D2") = "Fujitsu" Then
    For Each cell In rng
        If Len(cell) = 4 Then
            cell.Value = cell.Value & "4"
        End If
    Next cell

 ElseIf Range("D2") = "HP" Then
    For Each cell In rng
        If Len(cell) = 4 Then
            cell.Value = cell.Value & "5"
        End If
    Next cell

 ElseIf Range("D2") = "Lenovo" Then
    For Each cell In rng
        If Len(cell) = 4 Then
            cell.Value = cell.Value & "6"
        End If
    Next cell

 ElseIf Range("D2") = "Samsung" Then
    For Each cell In rng
        If Len(cell) = 4 Then
            cell.Value = cell.Value & "7"
        End If
    Next cell
End If

Range("A" & Cells.Rows.Count).End(xlUp).Select
data_text = ActiveCell.Value

        Cells.Find(What:=data_text, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=True).Activate
ActiveCell.Value = ActiveCell.Value & "3"

End Sub

Answer 1

我希望我已经理解了这一点，因为您的问题有点含糊（我应该先问一下...）

无论如何，以当前格式编写的代码将很快变得难以管理。就个人而言，我会将密钥和代码对保存在单独的表中，并在VBA中引用它们以生成<dependency> <groupId>org.eclipse.birt</groupId> <artifactId>report-engine</artifactId> <version>3.7.0</version> </dependency> <dependency> <groupId>org.eclipse.birt</groupId> <artifactId>org.eclipse.birt.report.engine</artifactId> <version>2.2.0-20070705</version> </dependency> <dependency> <groupId>org.eclipse.birt</groupId> <artifactId>core</artifactId> <version>3.7.0</version> </dependency> <dependency> <groupId>org.eclipse.birt.runtime</groupId> <artifactId>viewservlets</artifactId> <version>4.2.0</version> </dependency> ，但在此示例中，我是内联生成的。我也将您的过程重写为Dictionary，以便可以在主Function中引用它们。您可能需要更新工作表引用/范围，但我尝试尽可能地推断它们。

在Sub上，我在Sheet1 2中选择了输入。一旦选择了输入，请致电Row Sub。首先将根据输入生成前缀。然后它将找到所有具有相同前缀的SKU，并将最后4位数字加1。然后，它将在GenerateSKU中的SKU列表的末尾附加一个新SKU，并显示一个Sheet2新的SKU。

类似地，可以通过选择SKU并运行MsgBox子项来对它们进行解码

DecodeSKU

---

Option Explicit
Public Sub GenerateSKU()
    Dim ExistingSKU As Range
    Dim MaxExistingSKUNum As Long, LastSKU As Long
    Dim firstExistingSKUAddress As String, NewSKU As String, SKU As String, SKUPreFix As String

    With Sheet1
        SKUPreFix = EncodeKopioi(1, .Range("A2").Value2) & _
                    EncodeKopioi(2, .Range("B2").Value2) & _
                    EncodeKopioi(3, .Range("C2").Value2) & _
                    EncodeKopioi(4, .Range("D2").Value2)
    End With

    With Sheet2
        With .Range("A:A")
            Set ExistingSKU = .Find(what:=SKUPreFix, lookat:=xlPart)
            If Not ExistingSKU Is Nothing Then
                firstExistingSKUAddress = ExistingSKU.Address
                Do
                    If Left(ExistingSKU.Value2, 5) = SKUPreFix And MaxExistingSKUNum < Val(Right(ExistingSKU.Value2, 4)) Then
                        MaxExistingSKUNum = Val(Right(ExistingSKU.Value2, 4))
                    End If
                    Set ExistingSKU = .FindNext(ExistingSKU)
                Loop Until ExistingSKU Is Nothing Or ExistingSKU.Address = firstExistingSKUAddress
            End If
        End With
        NewSKU = SKUPreFix & Format(MaxExistingSKUNum + 1, "0000")
        LastSKU = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Cells(LastSKU + 1, 1).Value2 = NewSKU
    End With

    MsgBox NewSKU
End Sub

---

Public Sub DecodeSKU()
    With ActiveCell
        MsgBox EncodeKopioi(1, .Value2, True) & vbNewLine & _
               EncodeKopioi(2, .Value2, True) & vbNewLine & _
               EncodeKopioi(3, .Value2, True) & vbNewLine & _
               EncodeKopioi(4, .Value2, True)
    End With
End Sub

Answer 2

尝试

Sub test()
    Dim rngDB As Range
    Dim rngT As Range
    Dim s, s2, s3, s4
    Dim n As Long

    Select Case Range("a2")
        Case "Tietokoneet"
            s = "01"
        Case "Komponentit"
            s = "02"
        Case "Oheislaite"
            s = "03"
        Case "Ohjelmisto"
            s = "04"
        Case "Verkko"
            s = "05"
        Case "Mobiililaite"
            s = "06"
        Case "Tarvikkeet"
            s = "07"
        Case "Palvelu"
            s = "08"
    End Select

    Select Case Range("b2")
        Case "Kannettavat"
            s2 = "1"
        Case "Poytakoneet"
            s2 = "2"
        Case "Kaytetyt"
            s2 = "3"
    End Select

    Select Case Range("c2")
        Case "_13"
            s3 = "1"
        Case "_14"
            s3 = "2"
        Case "_15.6"
            s3 = "3"
        Case "_17"
            s3 = "4"
        Case "Yrityskannettavat"
            s3 = "5"
    End Select
    Select Case Range("d2")
        Case "Acer"
            s4 = "1"
        Case "Apple"
            s4 = "2"
        Case "ASUS"
            s4 = "3"
        Case "Fujitsu"
            s4 = "4"
        Case "HP"
            s4 = "5"
        Case "Lenovo"
            s4 = "6"
        Case "Samsung"
            s4 = "7"
    End Select

    s = s & s2 & s3 & s4
    Set rngDB = Range("a2", Range("a" & Rows.Count).End(xlUp))
    n = WorksheetFunction.CountIf(rngDB, s & "*") + 1
    s = s & Format(n, "0000")
    Set rngT = Range("a" & Rows.Count).End(xlUp)
    Set rngT = rngT.Offset(1, 0)
    rngT = s

End Sub

结果图片