[已解决]求各位老师帮忙看一下怎么生成流水单号

cabcd1

根据日期生成前缀我可以用公式拉出来一列，其他问题不知道不知如何下手{:021:}，请各位老师看看{:091:}

最佳答案

月排行榜 / 总排行榜

zjdh

2016-6-24 10:39

VBA问题.rar (9.23 KB, 下载次数: 28)

2016-6-24 10:39 上传

点击文件名下载附件

跳转到最佳答案楼层

老司机带带我

1. Sub xx()
   
2.     Dim arr, brr(), d, n%, i%, str$
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     With Sheet1
   
5.         n = .Cells(.Rows.Count, 2).End(xlUp).Row
   
6.         arr = .Range("B2:C" & n)
   
7.         str = "I" & Mid(arr(1, 1), 3, 2) & Format(Month(arr(1, 1)), "00") & "001"
   
8.         ReDim Preserve brr(1 To 1)
   
9.         brr(1) = str
   
10.         x = 1
    
11.         For i = 2 To n - 1
    
12.             ReDim Preserve brr(1 To i)
    
13.             If x < 3 And arr(i, 1) = arr(i - 1, 1) And arr(i, 2) = arr(i - 1, 2) Then
    
14.                 brr(i) = str
    
15.                 x = x + 1
    
16.             Else
    
17.                 str = "I" & Mid(arr(i, 1), 3, 2) & Format(Month(arr(i, 1)), "00") & Format(Right(str, 3) + 1, "000")
    
18.                 brr(i) = str
    
19.                 x = 1
    
20.             End If
    
21.         Next
    
22.         .Range("D2:D" & n) = Application.WorksheetFunction.Transpose(brr)
    
23.     End With
    
24. End Sub

复制代码

zjdh

VBA问题.rar (9.23 KB, 下载次数: 28)

2016-6-24 10:39 上传

点击文件名下载附件

cabcd1

zjdh 发表于 2016-6-24 10:39

谢谢老师，这就是我想要的结果，真的非常感谢！

grf1973

1. Sub tt()
   
2.     arr = [a1].CurrentRegion
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     For i = 2 To UBound(arr)
   
5.         x = arr(i, 2) & arr(i, 3)
   
6.         d(x) = d(x) + 1
   
7.         If d(x) Mod 3 = 1 Then lsh = lsh + 1
   
8.         arr(i, 4) = "I1601" & Format(lsh, "000")
   
9.     Next
   
10.     [d1].Resize(UBound(arr)) = Application.Index(arr, , 4)
    
11. End Sub
    

复制代码

grf1973

考虑到日期改变引起前缀变化，或者数据有可能乱序，代码修改如下：

1. Sub tt()
   
2.     arr = [a1].CurrentRegion
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     For i = 2 To UBound(arr)
   
5.         x = arr(i, 2) & arr(i, 3)
   
6.         y = Format(arr(i, 2), "yymm")
   
7.         If Not d.exists(y) Then d(y) = 0
   
8.         d(x) = d(x) + 1
   
9.         If d(x) Mod 3 = 1 Then d(y) = d(y) + 1
   
10.         arr(i, 4) = "l" & y & Format(d(y), "000")
    
11.     Next
    
12.     [d1].Resize(UBound(arr)) = Application.Index(arr, , 4)
    
13. End Sub
    

复制代码