根据表中的值创建序列号

时间:2014-06-17 15:10:48

标签: vba

我很难想出这段代码。我知道足够的vba让自己陷入困境。我想要做的是为货架位置生成序列号。我希望它能够根据某些参数和规则自动生成数字。所以在仓库里有一些行,架子和位置。如果我要在表格中列出每个人的数量,例如

3排 2个货架 4个职位

我希望它根据有多少行/架子/位置吐出相关的序列号。在这种情况下,它将是:

R01-S01-P01, R01-S01-P02, R01-S01-P03, R01-S01-P04, R01-S02-P01, R01-S02-P02, R01-S02-P03, R01-S02-P04, R02-S01-P01, R02-S01-P02, R02-S01-P03, R01-S01-P04, R01-S02-P01, 等...

非常感谢您给予的任何想法或帮助!

Dim i As Integer, iPos As Integer, c As Integer, iRow As Integer, d As Integer, iShl As Integer

iPos = Worksheets("Sheet1").Cells(3, "J").Value
iShl = Worksheets("Sheet1").Cells(3, "I").Value
iRow = Worksheets("Sheet1").Cells(3, "H").Value
For i = 1 To iPos * iShl * iRow
 Cells(i, 3).Value = i
    For d = 1 To iShl
        Cells(i, 2).Value = d
            For c = 1 To iRow
                Cells(c, 1).Value = i
            Next c
    Next d
Next i

1 个答案:

答案 0 :(得分:0)

@ user3749080。好的尝试。这是我的代码如下。我已经测试了,它似乎与我如何理解您正在寻找的内容有关。

我做出的最大改变是将位数拉出来,将2位数字(对于那些小于10的数字)输出到一个单独的函数中。

<强>更新

我已更改代码以创建空白或0的检查,并仍然使用该条件创建序列号。

Option Explicit

Sub CreateSerials()
    Application.ScreenUpdating = False

    Dim i_P     As Integer
    Dim iPos    As Integer
    Dim initP   As Integer
    Dim i_R     As Integer
    Dim iRow    As Integer
    Dim initR   As Integer
    Dim i_S     As Integer
    Dim iShl    As Integer
    Dim initS   As Integer

    iPos = Worksheets("Sheet1").Cells(3, "J").Value
    iShl = Worksheets("Sheet1").Cells(3, "I").Value
    iRow = Worksheets("Sheet1").Cells(3, "H").Value

    If iPos = 0 Then
        initP = 0
    Else
        initP = 1
    End If

    If iShl = 0 Then
        initS = 0
    Else
        initS = 1
    End If

    If iRow = 0 Then
        initR = 0
    Else
        initR = 1
    End If

    Range("C:C").ClearContents
    For i_R = initR To iRow
        For i_S = initS To iShl
            For i_P = initP To iPos
                Range("C1000000").End(xlUp).Offset(1, 0).Value = _
                    "R" & DoubleDigit(i_R) & "-S" & DoubleDigit(i_S) & "-P" & DoubleDigit(i_P)
            Next i_P
        Next i_S
    Next i_R

    Application.ScreenUpdating = True

    MsgBox Application.WorksheetFunction.CountA(Range("C:C")) & " serial numbers were created"
End Sub

Function DoubleDigit(i_Input As Integer) As String
    If i_Input < 10 Then
        DoubleDigit = "0" & i_Input
    Else
        DoubleDigit = i_Input
    End If
End Function