VAB两个代码融合到一起怎么修改

yaozhaoze

老师您好：
     VAB两个代码融合到一起怎么修改，代码一运行以后运行代码二。感谢各位老师帮忙 ，十分感谢. 谢谢
代码一：
Sub 送货单执行()  '//2024.1.8
Dim ar, br, r, i, k, wb, d, m, n
    k = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
    With Sheet1.Sort
        .SortFields.Add Key:=Sheet1.Range("B2:B" & k)
        .SortFields.Add Key:=Sheet1.Range("J2:J" & k)
        .SortFields.Add Key:=Sheet1.Range("S2:S" & k)
        .SortFields.Add Key:=Sheet1.Range("M2:M" & k)
        .SetRange Range("A1:T" & k)
        .Header = xlYes
        .Apply
    End With
    ar = Sheet1.[a1].CurrentRegion
    br = Sheet2.Range("A1:X" & k)
    Set d = CreateObject("scripting.dictionary")
    Set r = CreateObject("vbscript.regexp")
    r.Pattern = "\x5b.+\x5d|\x28.+\x29|SQ|AWG|SSX-F|印字|挤压|R2XB91Y |Y/O,Y/L,Y/G,GY,L/W,L/O|W/B,YL/BK,YL/GN|WH/BK,YL/BK,YL/GN|WH,RD,BL,BN|WH,RD,BL,WH|W,R,L,BN|WH,RD,BN,BL|WH/BL,WH/GN|1X"
    r.Global = True
    For i = 2 To k
        br(i, 1) = Split(ar(i, 19), "-")(0)
        br(i, 2) = Format(Split(ar(i, 19), "-")(1), "00000")
        br(i, 6) = ar(i, 15)
        br(i, 17) = Int(ar(i, 11))
        br(i, 18) = ar(i, 3)
        br(i, 19) = Left(ar(i, 3), 4) + 1 & Right(ar(i, 3), 4)
        br(i, 21) = Right(ar(i, 2), 2) & " " & r.Replace(ar(i, 10), "")
        br(i, 24) = Right(ar(i, 2), 2)
        d(br(i, 24)) = 1
    Next i
    Sheet2.Range("X2:X" & k).NumberFormatLocal = "@"
    Sheet2.[a1].Resize(k, 24) = br

    For Each m In d.keys
        Set wb = Workbooks.Add
        With wb.Sheets(1)
            .Cells.NumberFormatLocal = "@"
            .[a1].Resize(1, 24) = Application.Index(br, 1, 0)
            n = 1
            For i = 2 To k
                If br(i, 24) = m Then
                    n = n + 1
                    For j = 1 To 24
                        .Cells(n, j) = br(i, j)
                    Next j
                End If
            Next i
        End With
        wb.SaveAs ThisWorkbook.Path & "\" & m & ".xlsx"
        wb.Close
    Next m

代码二：
End Sub
Sub test2()
Dim sht As Worksheet, sht1 As Worksheet
Dim arr, d As Object, i
Set d = CreateObject("scripting.Dictionary")
Set sht = Sheets("托盘清单")
Set sht1 = Sheets("送货单登记")
arr = sht.Range("A1").CurrentRegion
sht1.Range("B1").CurrentRegion.Offset(1).ClearContents
For i = 2 To UBound(arr)
    d(arr(i, 2)) = ""
Next
sht1.Range("B2").Resize(d.Count, 1) = WorksheetFunction.Transpose(d.keys)
End Sub

3190496160

call test2
放到第一段代码的最后

feilanga

feilanga

sub  end sub 是1对使用的，此为完整过程。