Question

我有下面的代码工作正常，但我试图修改代码无效，以便它保存带有前导零的文件。

数字元素是商店编号，范围从1到168

理想情况下，如果可能，您可以建议如何更改代码，以便在存储编号为2位数字和3位数字等时保存输出文件，如下例所示。

0001 0010 0120

Sub GenerateOutput()

    Dim i As Long
    Dim iGradeRow As Long
    Dim iGradeCol As Long
    Dim iPosSeqRow As Long

    Dim s(1 To 7) As String

    Dim aGradeData() As Variant
    Dim aPosSeq() As Variant

    Dim aOutput(1 To 500000, 1 To 12) As Variant
    Dim iNextOutputRow As Long

    Dim ExportWorkbook As Workbook

    Dim Site As String
    Dim Department As String
    Dim Category As String
    Dim ArticleGrade As String
    Dim dp As String
    Dim ct As String
    Dim posQty As Long
    Dim y As Long
    Dim lrStores As Long
    Dim recordId As Long
    Dim selId As Long

    '------------------------

    Application.ScreenUpdating = False

    ' Get arrays of data to loop round
    With ws_Grades
        aGradeData = .Cells(1, 1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, .Cells(1, .Columns.Count).End(xlToLeft).Column).Value2
    End With
    With ws_PosSeq
        aPosSeq = .Cells(1, 1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, 20).Value2
    End With

    s(1) = "( "
    's(2) = iGradeRow - 3
    s(3) = " / "
    's(4) = UBound(aGradeData, 1) - 3
    s(5) = " ) "
    's(6) = "Collecting data for: "
    's(7) = aGradeData(iGradeRow, 2)
    'Application.StatusBar = Join(s)
    'DoEvents: DoEvents

    'check the departments and categories
    For iGradeRow = 4 To UBound(aGradeData, 1)

        's(1) = "( "
        s(2) = iGradeRow - 3
        's(3) = " / "
        s(4) = UBound(aGradeData, 1) - 3
        's(5) = " ) "
        s(6) = "Collecting data for: "
        s(7) = aGradeData(iGradeRow, 2)
        Application.StatusBar = Join(s)
        DoEvents: DoEvents
        Application.ScreenUpdating = False

        Erase aOutput
        iNextOutputRow = 1

        For iGradeCol = 3 To UBound(aGradeData, 2)

            Site = aGradeData(iGradeRow, 1)
            Department = aGradeData(1, iGradeCol)
            Category = aGradeData(3, iGradeCol)
            ArticleGrade = aGradeData(iGradeRow, iGradeCol)

            If iNextOutputRow = 1 Then
                recordId = 1
                selId = 1
            Else
                recordId = aOutput(iNextOutputRow - 1, 1) + 1
                selId = aOutput(iNextOutputRow - 1, 2) + 1
            End If

            'check the departments & categories in the opened workbook
            For iPosSeqRow = 3 To UBound(aPosSeq, 1)

                'if there is nil in the first column, go to the next loop
                If aPosSeq(iPosSeqRow, 1) = 0 Then GoTo NextDepartment

                'if the department name and category name matches:
                If (Trim(LCase(aPosSeq(iPosSeqRow, 2))) = Trim(LCase(Department))) And (Trim(LCase(aPosSeq(iPosSeqRow, 3))) = Trim(LCase(Category))) Then

                    dp = aPosSeq(iPosSeqRow, 2)
                    ct = aPosSeq(iPosSeqRow, 3)

                    'check wether the grades match:
                    If Not Trim(LCase(aPosSeq(iPosSeqRow, 6))) = Trim(LCase(ArticleGrade)) Then GoTo NextValue

                    'check pos qty:
                    posQty = aPosSeq(iPosSeqRow, 12)

                    'check department: same like the last one?:

                    If Not iNextOutputRow = 1 Then

                        If Trim(LCase(aOutput(iNextOutputRow - 2, 7))) = Trim(LCase(Site)) And _
                           Trim(LCase(aOutput(iNextOutputRow - 2, 5))) = Trim(LCase(dp)) And _
                           Trim(LCase(aOutput(iNextOutputRow - 2, 6))) = Trim(LCase(ct)) Then GoTo Level3

                        If Trim(LCase(aOutput(iNextOutputRow - 2, 7))) = Trim(LCase(Site)) And _
                           Trim(LCase(aOutput(iNextOutputRow - 2, 5))) = Trim(LCase(dp)) And _
                           Trim(LCase(aOutput(iNextOutputRow - 2, 6))) <> Trim(LCase(ct)) Then GoTo Level2

                        If Trim(LCase(aOutput(iNextOutputRow - 2, 7))) = Trim(LCase(Site)) And _
                           Trim(LCase(aOutput(iNextOutputRow - 2, 5))) <> Trim(LCase(dp)) And _
                           Trim(LCase(aOutput(iNextOutputRow - 2, 6))) <> Trim(LCase(ct)) Then GoTo Level2

                    End If

Level1:

                    ' Record Id
                    aOutput(iNextOutputRow, 1) = iNextOutputRow
                    ' SEL_ID
                    aOutput(iNextOutputRow, 2) = selId
                    ' Front + Back
                    aOutput(iNextOutputRow, 3) = "F"
                    ' Template_Type
                    aOutput(iNextOutputRow, 4) = "Store"
                    ' Store No
                    aOutput(iNextOutputRow, 7) = Site

                    iNextOutputRow = iNextOutputRow + 1

                    ' Record Id
                    aOutput(iNextOutputRow, 1) = iNextOutputRow
                    ' SEL_ID
                    aOutput(iNextOutputRow, 2) = selId
                    ' Back
                    aOutput(iNextOutputRow, 3) = "B"
                    ' Template_Type
                    aOutput(iNextOutputRow, 4) = "Store"
                    ' Store No
                    aOutput(iNextOutputRow, 7) = Site

                    iNextOutputRow = iNextOutputRow + 1

Level2:

                    'Record Id
                    aOutput(iNextOutputRow, 1) = iNextOutputRow
                    'SEL_ID
                    aOutput(iNextOutputRow, 2) = aOutput(iNextOutputRow - 1, 2) + 1
                    'Front_Back
                    aOutput(iNextOutputRow, 3) = "F"
                    'Template_Type
                    aOutput(iNextOutputRow, 4) = "Category"
                    'Department
                    aOutput(iNextOutputRow, 5) = dp
                    'Category
                    aOutput(iNextOutputRow, 6) = ct
                    'Store No
                    aOutput(iNextOutputRow, 7) = Site

                    iNextOutputRow = iNextOutputRow + 1

                    'Record Id
                    aOutput(iNextOutputRow, 1) = iNextOutputRow
                    'SEL_ID
                    aOutput(iNextOutputRow, 2) = aOutput(iNextOutputRow - 1, 2)
                    'Front_Back
                    aOutput(iNextOutputRow, 3) = "B"
                    'Template_Type
                    aOutput(iNextOutputRow, 4) = "Category"
                    'Department
                    aOutput(iNextOutputRow, 5) = dp
                    'Category
                    aOutput(iNextOutputRow, 6) = ct
                    'Store No
                    aOutput(iNextOutputRow, 7) = Site

                    iNextOutputRow = iNextOutputRow + 1

Level3:

                    For i = 1 To posQty

                        'Record Id
                        aOutput(iNextOutputRow, 1) = iNextOutputRow
                        'SEL_ID
                        If i = 1 Then
                            aOutput(iNextOutputRow, 2) = aOutput(iNextOutputRow - 1, 2) + 1
                        Else
                            aOutput(iNextOutputRow, 2) = aOutput(iNextOutputRow - 1, 2)
                        End If
                        'Front_Back
                        aOutput(iNextOutputRow, 3) = "F"
                        'Template_Type
                        aOutput(iNextOutputRow, 4) = "SEL"
                        'Department
                        aOutput(iNextOutputRow, 5) = dp
                        'Category
                        aOutput(iNextOutputRow, 6) = ct
                        'Store No
                        aOutput(iNextOutputRow, 7) = Site
                        'Barcode No
                        aOutput(iNextOutputRow, 8) = aPosSeq(iPosSeqRow, 8)
                        'Article Description
                        aOutput(iNextOutputRow, 9) = aPosSeq(iPosSeqRow, 7)
                        'WasWas
                        aOutput(iNextOutputRow, 10) = aPosSeq(iPosSeqRow, 13)
                        'Was
                        aOutput(iNextOutputRow, 11) = aPosSeq(iPosSeqRow, 14)
                        'Now
                        aOutput(iNextOutputRow, 12) = aPosSeq(iPosSeqRow, 16)

                        iNextOutputRow = iNextOutputRow + 1

                        'Record Id
                        aOutput(iNextOutputRow, 1) = iNextOutputRow
                        'SEL_ID
                        aOutput(iNextOutputRow, 2) = aOutput(iNextOutputRow - 1, 2)
                        'Front_Back
                        aOutput(iNextOutputRow, 3) = "B"
                        'Template_Type
                        aOutput(iNextOutputRow, 4) = "SEL"
                        'Department
                        aOutput(iNextOutputRow, 5) = dp
                        'Category
                        aOutput(iNextOutputRow, 6) = ct
                        'Store No
                        aOutput(iNextOutputRow, 7) = Site
                        'Barcode No
                        aOutput(iNextOutputRow, 8) = aPosSeq(iPosSeqRow, 8)
                        'Article Description
                        aOutput(iNextOutputRow, 9) = aPosSeq(iPosSeqRow, 7)

                        iNextOutputRow = iNextOutputRow + 1

                    Next i

                End If
NextValue:
            Next iPosSeqRow
NextDepartment:

        Next iGradeCol

        's(1) = "( "
        's(2) = iGradeRow - 3
        's(3) = " / "
        's(4) = UBound(aGradeData, 1) - 3
        's(5) = " ) "
        s(6) = "Generating export for: "
        's(7) = aGradeData(iGradeRow, 2)
        Application.StatusBar = Join(s)
        DoEvents: DoEvents
        Application.ScreenUpdating = False

        ' Clean output data
        For i = 1 To iNextOutputRow
            aOutput(i, 1) = Format(aOutput(i, 1), "0000000")
            aOutput(i, 2) = Format(aOutput(i, 2), "0000000")
            aOutput(i, 7) = Format(aOutput(i, 7), "0000")
            aOutput(i, 8) = "'" & aOutput(i, 8)
        Next i

        ws_Output.Cells(2, 1).Resize(ws_Output.UsedRange.Rows.Count, 12).ClearContents
        ws_Output.Cells(2, 1).Resize(iNextOutputRow, 12).Value2 = aOutput
        Application.ScreenUpdating = False
        If ExportWorkbook Is Nothing Then
            Set ExportWorkbook = Workbooks.Add
            ThisWorkbook.Activate
        End If
        Application.ScreenUpdating = False
        ExportWorkbook.Worksheets(1).Cells.Clear
        ws_Output.UsedRange.Copy
        ExportWorkbook.Worksheets(1).Cells(1, 1).PasteSpecial xlPasteAll
        Application.CutCopyMode = False
        ExportWorkbook.SaveCopyAs ThisWorkbook.Path & Application.PathSeparator & aGradeData(iGradeRow, 1) & "_" & aGradeData(iGradeRow, 2) & "_" & Format(Now(), "ddmmyyyy_hhmm") & ".xlsx"
        ws_Output.Cells(2, 1).Resize(ws_Output.UsedRange.Rows.Count, 12).ClearContents

    Next iGradeRow

EndingSub:

    ExportWorkbook.Close False
    Set ExportWorkbook = Nothing

    Application.StatusBar = False
    Application.ScreenUpdating = True

    MsgBox "Generated Workbooks.", vbInformation

End Sub

Answer 1

在数字元素的左侧添加3个零并使用右（）得到精确的4位数

Answer 2

你不应该发布你的整个代码，而只是发布它的相关部分，这样就没有人需要搜索代码，找到import和部分。

问题：

要使用前导零填充数字，您可以执行以下操作：

Sub test()
    Dim numLen As Integer
    Dim i As Integer
    Dim test As String

    numLen = 4 '4 is the lengh like in your example `0001`

    'test = "1"
    'test = "11" 'Some numbers to test the code
    test = "111"

    'Depending on the Lenght of the String, additional leading zeros will be added
    For i = Len(test) To numLen - 1
        test = "0" & test
    Next

    MsgBox (test)
End Sub

保存文件的前导零的VBA格式编号

2 个答案: