求大神解决，问题看下面。

flash70

opiona

1. Private Sub CommandButton1_Click()
   
2.     Dim ARR
   
3.     Dim N1, X, Y As Long
   
4.     Dim SHT1 As Worksheet
   
5.     Dim BOX1, BOX2, STRX As String
   
6.     Dim BOOL As Boolean
   
7.    
   
8.     BOX1 = UserForm1.ComboBox1.Value
   
9.     BOX2 = UserForm1.ComboBox2.Value
   
10.     Set SHT1 = Sheets("成品编号")
    
11.    
    
12.    
    
13.     If BOX1 <> "" And BOX2 <> "" Then
    
14.         ARR = Split("A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z", ",")
    
15.         BOOL = False
    
16.         For X = 0 To UBound(ARR)
    
17.             For Y = 0 To UBound(ARR)
    
18.                 STRX = BOX2 & BOX1 & ARR(X) & ARR(Y)
    
19.                 Set C = SHT1.Range("A:A").Find(STRX, , LOOKAT:=xlWhole)
    
20.                 If C Is Nothing Then
    
21.                     N1 = SHT1.Cells(65536, 1).End(xlUp).Row + 1
    
22.                     SHT1.Cells(N1, 1) = STRX
    
23.                     BOOL = True
    
24.                     Exit For
    
25.                 End If
    
26.             Next
    
27.             If BOOL = True Then Exit For
    
28.         Next
    
29.         If BOOL = False Then
    
30.            MsgBox "PCB板类型和客户编号：已经全部占用，换个编号试试！"
    
31.         End If
    
32.     Else
    
33.         MsgBox "PCB板类型和客户编号不能为空"
    
34.     End If
    
35.    
    
36. End Sub

复制代码

opiona

QQ14885553.rar (32.46 KB, 下载次数: 7)

2018-7-22 09:35 上传

点击文件名下载附件

獨一無2

On Error GoTo Err
   
If Worksheets("成品编号").Range("A:A").Find(what:=Split(m, ",")(1), LookAt:=xlWhole).Column Then Exit Sub

Err:

    Dim mydic As Object, y As Integer, ke As String 在这之上加入上面的代码。

microyip

1. Private Sub CommandButton1_Click()
   
2.     Dim sBox1 As String, sBox2 As String
   
3.     sBox1 = UserForm1.ComboBox1.Value
   
4.     sBox2 = UserForm1.ComboBox2.Value
   
5.    
   
6.     If sBox1 <> "" And sBox2 <> "" Then
   
7.         If MsgBox("是否按顺序生产编号？" & Chr(13) & "是，顺序生产编号？" & Chr(13) & "否，随机生成编号", vbYesNo) = vbYes Then
   
8.             顺序生成编号 sBox1 & sBox2
   
9.         Else
   
10.             随机生成编号 sBox1 & sBox2
    
11.         End If
    
12.     Else
    
13.         MsgBox "PCB板类型和客户编号不能为空"
    
14.     End If
    
15. End Sub
    
16. [code]Sub 随机生成编号(ByVal sCodeType As String)
    
17.     Dim dicData As Object
    
18.     Dim vData As Variant, nRow As Integer, nI As Integer
    
19.     Dim sCode As String
    
20.    
    
21.     Application.ScreenUpdating = False
    
22.     sCodeType = "PM001"
    
23.     Set dicData = CreateObject("Scripting.Dictionary")
    
24.     For nRow = Asc("A") To Asc("Z")
    
25.         For nI = Asc("A") To Asc("Z")
    
26.             dicData(Chr(nRow) & Chr(nI)) = 0
    
27.         Next
    
28.     Next
    
29.     With Sheet4
    
30.         vData = .[A1].CurrentRegion.Value
    
31.         For nRow = 2 To UBound(vData)
    
32.             If vData(nRow, 1) Like sCodeType & "*" Then
    
33.                 sCode = Right(vData(nRow, 1), 2)
    
34.                 If dicData.Exists(sCode) Then dicData.Remove sCode
    
35.             End If
    
36.         Next
    
37.         If dicData.Count > 0 Then
    
38.             nRow = Int(Rnd() * dicData.Count)
    
39.             If nRow = dicData.Count And nRow > 0 Then nRow = nRow - 1
    
40.             sCode = sCodeType & dicData.Keys()(nRow)
    
41.             .Cells(.Cells.Rows.Count, 1).End(xlUp).Offset(1) = sCode
    
42.             MsgBox "新编号是【" & sCode & "】"
    
43.         Else
    
44.             MsgBox "该编号已经用完！"
    
45.         End If
    
46.     End With
    
47.     Application.ScreenUpdating = True
    
48. End Sub
    
49. 
    
50. Sub 顺序生成编号(ByVal sCodeType As String)
    
51.     Dim vData As Variant, nRow As Integer, nI As Integer
    
52.     Dim sCode As String
    
53.    
    
54.     Application.ScreenUpdating = False
    
55.     sCodeType = "PM001"
    
56.     With Sheet4
    
57.         vData = .[A1].CurrentRegion.Value
    
58.         For nRow = 2 To UBound(vData)
    
59.             If vData(nRow, 1) Like sCodeType & "*" Then
    
60.                 If Right(vData(nRow, 1), 2) > sCode Then sCode = Right(vData(nRow, 1), 2)
    
61.             End If
    
62.         Next
    
63.         If sCode = "ZZ" Then
    
64.             MsgBox "该编号已经用完！"
    
65.         Else
    
66.             If sCode = "" Then
    
67.                 sCode = sCodeType & "AA"
    
68.             Else
    
69.                 nRow = Asc(Left(sCode, 1))
    
70.                 nI = Asc(Right(sCode, 1))
    
71.                 If nI < Asc("Z") Then
    
72.                     nI = nI + 1
    
73.                     sCode = sCodeType & Left(sCode, 1) & Chr(nI)
    
74.                 Else
    
75.                     sCode = sCodeType & Chr(Asc(Left(sCode, 1)) + 1) & "A"
    
76.                 End If
    
77.             End If
    
78.             .Cells(.Cells.Rows.Count, 1).End(xlUp).Offset(1) = sCode
    
79.             MsgBox "新编号是【" & sCode & "】"
    
80.         End If
    
81.     End With
    
82.     Application.ScreenUpdating = True
    
83. End Sub
    

复制代码

[/code]

microyip

附上附件以供参考

凌空一羽

h6t5gfdas.zip (40.12 KB, 下载次数: 5)

2018-7-22 10:15 上传

点击文件名下载附件

flash70

opiona 发表于 2018-7-22 09:35

代码清晰，高手，谢谢，14885553是你QQ吗？

flash70

獨一無2 发表于 2018-7-22 09:54
On Error GoTo Err
   
If Worksheets("成品编号").Range("A:A").Find(what:=Split(m, ",")(1), LookAt ...

谢谢，你的方法很好，楼二解决了

flash70

microyip 发表于 2018-7-22 10:03
附上附件以供参考

谢谢，楼二解决了，A列如果是空的话会报错