[已解决]excel自动生成序列号编程

www040401

excel2007增加一个生成序列按钮，需实现功能如下：

1. 點擊“生成序号”按钮，在sheet2 中：序列号 栏自动生成序列号：编号+流水码（如 ABCDE1）；NO. 栏自动生产编码（从1开始）；日期栏 自动生产日期（当天）

2. 若sheet2中：存在序列号 栏的编号相同，则流水码自动加1（如 Sheet2中已存在ABCDE1，则点击“生成序号”按钮会自动在序列号 栏最后一列生成ABCDE2，以此类推

注：流水码：1~9；9之后是A~Z

       编号位数固定，但内容不定（数字+字母）
以上或见附件excel： BOOK.zip (11.03 KB, 下载次数: 11)

2016-1-22 16:12 上传

点击文件名下载附件

望各位大大帮忙，感激不尽！

最佳答案

月排行榜 / 总排行榜

grf1973

2016-1-25 13:22

1. Sub 生成序号()
   
2.     Dim xRng As Range
   
3.     bm = Sheet1.[a2]
   
4.     xl = "123456789ABCEFGHIJKLMNOPQRSTUVWXYZ"
   
5.     With Sheet2
   
6.         Set xRng = .Range("b:b").Find(bm, , , , , xlPrevious)
   
7.         r = .[a65536].End(3).Row + 1
   
8.         .Cells(r, 1) = Val(.Cells(r - 1, 1)) + 1
   
9.         .Cells(r, 3) = Date
   
10.         If xRng Is Nothing Then
    
11.             .Cells(r, 2) = bm & "1"
    
12.         Else
    
13.             xh = Right(xRng, 1)
    
14.             x = InStr(xl, xh)
    
15.             If x < Len(xl) Then xh = Mid(xl, x + 1, 1) Else xh = 1
    
16.             .Cells(r, 2) = bm & xh
    
17.         End If
    
18.     End With
    
19. End Sub
    

复制代码

跳转到最佳答案楼层

www040401

大神啊~难道还没收到我的SOS呼叫？？

grf1973

1. Sub 生成序号()
   
2.     bm = Sheet1.[a2]
   
3.     xl = "123456789ABCEFGHIJKLMNOPQRSTUVWXYZ"
   
4.     With Sheet2
   
5.         r = .[a65536].End(3).Row + 1
   
6.         .Cells(r, 1) = Val(.Cells(r - 1, 1)) + 1
   
7.         .Cells(r, 3) = Date
   
8.         If r = 2 Then
   
9.             .Cells(r, 2) = bm & "1"
   
10.         Else
    
11.             xh = Right(.Cells(r - 1, 2), 1)
    
12.             x = InStr(xl, xh)
    
13.             If x < Len(xl) Then xh = Mid(xl, x + 1, 1) Else xh = 1
    
14.             .Cells(r, 2) = bm & xh
    
15.         End If
    
16.     End With
    
17. End Sub
    

复制代码

www040401

grf1973 发表于 2016-1-22 17:03

非常感谢，已经实现了大半功能，还有一点小瑕疵（如下图）还望帮忙修改一下，谢谢！
注：若编号相同，流水码才会加1，若编号不同，则流水码会从1开始

www040401

grf1973 发表于 2016-1-22 17:03

哈罗~可否再帮忙修改一下程序？我开始的想法是使用搜索定位序列号最后的流水码：搜索到n个相同项，则最后序列号流水码为n+1，搜索一次即结束。但程序总是错误，唉~老要命了……拜托帮帮忙，3Q~~Q

grf1973

1. Sub 生成序号()
   
2.     Dim xRng As Range
   
3.     bm = Sheet1.[a2]
   
4.     xl = "123456789ABCEFGHIJKLMNOPQRSTUVWXYZ"
   
5.     With Sheet2
   
6.         Set xRng = .Range("b:b").Find(bm, , , , , xlPrevious)
   
7.         r = .[a65536].End(3).Row + 1
   
8.         .Cells(r, 1) = Val(.Cells(r - 1, 1)) + 1
   
9.         .Cells(r, 3) = Date
   
10.         If xRng Is Nothing Then
    
11.             .Cells(r, 2) = bm & "1"
    
12.         Else
    
13.             xh = Right(xRng, 1)
    
14.             x = InStr(xl, xh)
    
15.             If x < Len(xl) Then xh = Mid(xl, x + 1, 1) Else xh = 1
    
16.             .Cells(r, 2) = bm & xh
    
17.         End If
    
18.     End With
    
19. End Sub
    

复制代码

www040401

grf1973 发表于 2016-1-25 13:22

問題已解決~非常感謝!{:35:}