如果按照日期，自动递增并显示数字

fifi0703

想做一张发货单

每次打印完发货单都可以保存在记录表里面，那么在打下一单的时候，我希望系统可以自动检测记录表里相同日期的最后序号是多少，然后自动递增一位填入“I6”单元格。

就如比记录表里已经有“2017111901”这个日期批号了，那么我希望，当我在“H6”里输入2017-11-19时，后面的序号格“I6”可以自动生成一个“02”

以此类推。
按时间自动递增序号.rar (23.33 KB, 下载次数: 10)

2017-11-22 16:36 上传

点击文件名下载附件

请各位老师指教，谢谢！

fifi0703

不知道能不能在“发货单”这张表里面直接做一个Private Sub Worksheet_Change

uynayna

=IF(MAX(记录表!A3:A1045876)<TEXT(NOW(),"yyyymmdd") & "01",TEXT(NOW(),"yyyymmdd") & "01",MAX(记录表!A3:A1045876)+1)

fifi0703

uynayna 发表于 2017-11-22 16:50
=IF(MAX(记录表!A3:A1045876)

首先，这公式是针对所有的时期，不仅仅局限于某一个日期。我想要的是某一天里的序号递增。其次它最后显示出来的是整个日期批号，我只需要它显示后2位，谢谢！

uynayna

1. Sub test()
   
2.     Dim x As String, no As String
   
3.     Dim arr
   
4.     Dim i%, r%
   
5.     x = Format(Range("h6"), "yyyymmdd")
   
6.     r = Sheets("记录表").Range("a65536").End(xlUp).Row
   
7.     arr = Sheets("记录表").Range("a3:a" & r)
   
8.     no = "01"
   
9.     For i = 1 To UBound(arr)
   
10.         If x = Left(arr(i, 1), 8) Then
    
11.             If no <= Right(arr(i, 1), 2) Then no = Application.WorksheetFunction.Text(Right(arr(i, 1), 2) + 1, "00")
    
12.         End If
    
13.     Next
    
14.     [i6] = no
    
15. End Sub

复制代码

触发自己搞

fifi0703

uynayna 发表于 2017-11-22 20:55
触发自己搞

运行了一下，提示“溢出堆栈空间”，是不是无限调用了自身？

uynayna

递归我不会啊，测试正常。

fifi0703

uynayna 发表于 2017-11-23 10:21
递归我不会啊，测试正常。

放到触发里显示溢出，我再研究下，十分感谢！

chxw68

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.   If Target.Count > 1 Then
   
3.     Exit Sub
   
4.   End If
   
5.   If Target.Address = "$H$6" Then
   
6.     rq = Format(Target.Value, "yyyymmdd")
   
7.     With Worksheets("记录表")
   
8.       r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
9.       arr = .Range("a3:a" & r)
   
10.       n = 0
    
11.       For i = 1 To UBound(arr)
    
12.         If Left(arr(i, 1), 8) = rq Then
    
13.           bh = Val(Right(arr(i, 1), 2))
    
14.           If n < bh Then
    
15.             n = bh
    
16.           End If
    
17.         End If
    
18.       Next
    
19.     End With
    
20.     Target.Offset(0, 1) = Format(n + 1, "00")
    
21.   End If
    
22. 
    
23. End Sub
    

复制代码

chxw68

详见附件。