如何用VB解决以日期和数量自动生成编号

BMW5566

各位高手：

能否帮我解决用VB以日期和数量自动生成编号，之前有高手用函数进行解决，但是数量太多，运算起来太卡了，所以再次求助，详见附件，不胜感激！

sa3131

1. '需要在指定工作表中插入代码
   
2. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
3. 
   
4. If Target.Column <> 12 Then Exit Sub
   
5. If Target.Count = 1 Then If Target = "" Then Exit Sub
   
6. 
   
7. r = Target.Row: c = Target.Column
   
8. rq = Format(Target.Value2(1, 1), "yymmdd")
   
9. 
   
10. For i = 3 To r - 1
    
11.     lsh1 = lsh1 + Cells(i, c - 3)
    
12. Next i
    
13. lsh2 = Cells(r, c - 3)
    
14. 
    
15. For i = lsh1 + 1 To lsh1 + lsh2
    
16.     bh = "SQB" & rq & Format(i, "0000")
    
17.     ic = ic + 1
    
18.     Cells(r, 12 + ic) = bh
    
19. Next i
    
20. 
    
21. End Sub

复制代码

BMW5566

sa3131 发表于 2018-8-2 22:47

感谢您的帮忙，但是得出的效果怪怪，和我想要的结果有点差别，我在解释下：
假设：我在I3里输入数量5（I3和I4是合并单元格），那么M3~T3这个区域内会根据L3的日期自动生成5个编号，编号规则“SQB”+“18”（年）+“05”（月）+“02”（日）+“0001”（流水号）

接下来：我在I5里输入数量1（I5和I6是合并单元格），那么M5~T5这个区域内会根据L5的日期自动生成1个编号，编号规则“SQB”+“18”（年）+“06”（月）+“09”（日）+“0006”（流水号）

以此类推

备注：日期随时可能更改，那么编号也跟随更改；
         数量随时可能更改，编号的数量也跟随更改；例如I3的数量5改为3，那么M3~T3这个区域内编号由原来的5个编号自动变成3个编号，以下的流水号也自动变动更新；

麻烦您再看看是否能解决！谢谢，其他高手也帮忙看看！

魂断蓝桥

BMW5566 发表于 2018-8-3 09:52
感谢您的帮忙，但是得出的效果怪怪，和我想要的结果有点差别，我在解释下：
假设：我在I3里输入数量5（I ...

Sub a()
Dim arr, brr(1 To 999, 1 To 20), i%, j%, r%, m%, T%
r = [i999].End(3).Row
arr = Range("i3:l" & r + 1)
For i = 1 To UBound(arr) Step 2
    For j = 1 To arr(i, 1)
        m = m + 1
        T = T + 1
        brr(i, m) = "SQB" & Format(arr(i, 4), "YYMMDD") & Format(T, "0000")
    Next
    m = 0
Next
[M3:T99] = ""
[M3].Resize(999, 20) = brr

gbgbxgb

BMW5566 发表于 2018-8-3 09:52
感谢您的帮忙，但是得出的效果怪怪，和我想要的结果有点差别，我在解释下：
假设：我在I3里输入数量5（I ...

1. <blockquote>

复制代码

gbgbxgb

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Dim theInputRow&, theDate As Date, theYear&, theMonth&, theDay&
   
3.     Dim theColumn&, theNum&, theValue As Variant
   
4.     '
   
5.     With Target
   
6.         theInputRow = .Row
   
7.         If theInputRow < 2 Then End
   
8.         theColumn = .Column
   
9.     End With
   
10.     '
    
11.     Application.EnableEvents = False
    
12.     If theColumn = 9 Or theColumn = 12 Then
    
13.         With Me
    
14.             .Range(.Cells(theInputRow, 13), .Cells(theInputRow, 20)).ClearContents
    
15.             theValue = .Cells(theInputRow, 9)
    
16.             If IsNumeric(theValue) Then
    
17.                 theNum = CLng(theValue)
    
18.                 If theNum > 0 Then
    
19.                     theValue = .Cells(theInputRow, 12)
    
20.                     If IsDate(theValue) Then
    
21.                         theDate = CDate(theValue)
    
22.                         theYear = Year(theDate)
    
23.                         theMonth = Month(theDate)
    
24.                         theDay = Day(theDate)
    
25.                         Call theStrInput(theInputRow, theNum, theYear, theMonth, theDay)
    
26.                     End If
    
27.                 End If
    
28.             End If
    
29.         End With
    
30.     End If
    
31.     Application.EnableEvents = True
    
32. End Sub
    
33. 
    
34. Private Sub theStrInput(theInputRow&, theNum&, theYear&, theMonth&, theDay&)
    
35.     Dim thePreviousRow&, theStr$, thePreviousNum&, theColumn&
    
36.     Dim i&, a As Variant, theStrFirst$, theStrLast$
    
37.     '
    
38.     thePreviousRow = theInputRow - 2
    
39.     With Me
    
40.         Do While thePreviousRow > 1
    
41.             For theColumn = 20 To 13 Step -1
    
42.                 theStr = .Cells(thePreviousRow, theColumn)
    
43.                 If theStr <> "" Then
    
44.                     theStr = Right(theStr, 4)
    
45.                     If IsNumeric(theStr) Then thePreviousNum = CLng(theStr)
    
46.                     Exit Do
    
47.                 End If
    
48.             Next theColumn
    
49.             thePreviousRow = thePreviousRow - 2
    
50.         Loop
    
51.         theStrFirst = "SQB" & Right(theYear, 2) & Format(theMonth, "00") & Format(theDay, "00")
    
52.         ReDim a(1 To theNum)
    
53.         For i = 1 To theNum
    
54.             theStrLast = theStrFirst & Format(i + thePreviousNum, "0000")
    
55.             a(i) = theStrLast
    
56.         Next i
    
57.         .Cells(theInputRow, 13).Resize(, theNum) = a
    
58.     End With
    
59. End Sub

复制代码

BMW5566

gbgbxgb 发表于 2018-8-3 11:33

您好！感谢帮忙
但是有些问题，您帮忙写的代码里日期是需要人工手写输入的，但我的表格之前有代码：日期是自动生成的，例如：我编辑B3的数据，那么L3就会自动更新日期！看能否结合自动生成的日期帮忙再修订下您的代码，也就是根据人工输入的数量，再结合原有自动生成的日期，而编译出自动生成编号的代码，谢谢！

gbgbxgb

BMW5566 发表于 2018-8-3 14:50
您好！感谢帮忙
但是有些问题，您帮忙写的代码里日期是需要人工手写输入的，但我的表格之前有代码：日期 ...

如果L列的日期是手动编辑B列引起的结果，那么，把代码中的12改成2就可以了(注：仅指theColumn = 12中的12)。

gbgbxgb

BMW5566 发表于 2018-8-3 14:50
您好！感谢帮忙
但是有些问题，您帮忙写的代码里日期是需要人工手写输入的，但我的表格之前有代码：日期 ...

如果L列的日期是手动编辑B列引起的结果，那么，把代码中的12改成2就可以了(注：仅指theColumn = 12中的12)。
事后：
因网站问题，重复跟帖了。
那就借本楼提醒下:
(1)最好把if theNum > 0 Then修改为If theNum > 0 And theNum < 9 Then
(2)上述手动B列的单元格如果与存在合并单元格的I列(即数量列)不一样，即B列不存在合并单元格，代码还要作相关修改。(3)4楼的代码你为何不借鉴呀。对该代码稍加修改或许才是你要的。

BMW5566

gbgbxgb 发表于 2018-8-3 15:41
如果L列的日期是手动编辑B列引起的结果，那么，把代码中的12改成2就可以了(注：仅指theColumn = 12中的12 ...

我也想借鉴4楼的试用下，但因为是菜鸟，代码复制进去没反应