求助，大神帮帮忙，序列指定数量生成

496033221

帮忙把Q7中的条码，通过D18中指定的数量，自动按顺序填充的新的表格中，比方说尾数后四位是序列，指定150个，就是从0001--0150

鄂龙蒙

1. Sub 生成编码()
   
2.     Dim d(6), a(6), ar, arr, sa, s, i
   
3.     For i = 0 To 6
   
4.         Set d(i) = CreateObject("Scripting.Dictionary")
   
5.     Next
   
6.     Range("B1:B10000").ClearContents
   
7.     Application.ScreenUpdating = False
   
8.     ar = Sheet2.UsedRange
   
9.     For i = 2 To 10: d(0)(ar(i, 1)) = ar(i, 2): Next
   
10.     For i = 2 To 17: d(1)(ar(i, 4)) = ar(i, 5): Next
    
11.     For i = 2 To 23: d(2)(ar(i, 7)) = ar(i, 8): Next
    
12.     For i = 2 To 5: d(3)(ar(i, 10)) = ar(i, 11): Next
    
13.     For i = 10 To 21: d(4)(ar(i, 10)) = ar(i, 11): Next
    
14.     For i = 2 To 27: d(5)(ar(i, 13)) = ar(i, 14): Next
    
15.     For i = 2 To 13: d(6)(ar(i, 16)) = ar(i, 17): Next
    
16.     arr = Sheet1.Range("D9:D18")
    
17.     sa = Array(0, 1, 2, 3, 5, 6, 4)
    
18.     For i = 0 To 6
    
19.         If d(sa(i)).exists(arr(i + 1, 1)) Then a(i) = d(sa(i))(arr(i + 1, 1))
    
20.     Next
    
21.     s = a(0) & a(1) & a(2) & "18" & a(6) & a(3) & a(4) & a(5) & Format(arr(8, 1), "00")
    
22.     For i = 1 To arr(10, 1)
    
23.         Cells(i, 2) = s & Format(i, "0000")
    
24.     Next
    
25.     Application.ScreenUpdating = True
    
26. End Sub

复制代码

496033221

鄂龙蒙 发表于 2018-5-6 17:13

好，很好用，就是生成的序列号怎么复制到新建表，还请指导