求高手指点：根据条件一键自动编号

LOYOTO

如图根据件号和小名  给 单号 编号，在窗口输入一次就能编号，为什么我的窗口不停的提示，10行就要输入10次。求高手指点。





Sub 根据条件编号()
Set d = CreateObject("scripting.dictionary")
Application.ScreenUpdating = False
For j = 2 To Cells(Rows.Count, 1).End(3).Row
If Not d.Exists((Cells(j, 5).Value) & (Cells(j, 4).Value)) Then
  d((Cells(j, 5).Value) & (Cells(j, 4).Value)) = d.Count
End If
    ss = Application.InputBox("请输入数字", "输入提示", , , , , , 1) '输入非数字则会提示无效的数字
    Cells(j, 1) = "2023-" & Cells(j, 3) & "-" & ss + d((Cells(j, 5).Value) & (Cells(j, 4).Value)) + 1
Next j
Dim i As Integer
Dim maxRow As Integer
For i = 1 To ActiveWorkbook.Worksheets.Count
    Set sht = ActiveWorkbook.Worksheets(i) '激活当前工作表，Sort只能排序当前工作表
    sht.Activate   '获取当前表最大行数
    maxRow = sht.UsedRange.Rows.Count  '选取范围进行排序：这里是选取a3：ao41（前两行因为是标题，所以不选）；key是排序的列，这里写a3，表示以a列为依据排序，最多可以写3个key；order表示升序降序；Header表示是否有标题，由于我们没选a1、a2，所以这里写no
    sht.Range("A2:P" & maxRow).Sort key1:=sht.Range("O2"), order1:=xlAscending, Header:=xlNo
Next i
Application.ScreenUpdating = True
End Sub

ykcbf1100

没看出件号、小名和单号有啥关系。

gwjkkkkk

不知道是不是这个意思？？？

LOYOTO

ykcbf1100 发表于 2023-7-9 18:34
没看出件号、小名和单号有啥关系。

先按件号分，如果对应的小号不一样则分开编号，如果件号对应的小号一样，则编号一样。排序前要按件号先排序。

LOYOTO

gwjkkkkk 发表于 2023-7-9 18:52
不知道是不是这个意思？？？

是的，就是这样的，能不能加一个条件，编号按四位数，编号前先给件号排序，谢谢老师。

gwjkkkkk

LOYOTO 发表于 2023-7-9 20:03
是的，就是这样的，能不能加一个条件，编号按四位数，编号前先给件号排序，谢谢老师。

请参考附件。。。