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

flash70

凌空一羽 发表于 2018-7-22 10:15

谢谢，楼二解决了，你的方法不行

microyip

flash70 发表于 2018-7-22 10:25
谢谢，楼二解决了，A列如果是空的话会报错

代码修正

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

复制代码

microyip

附上新附件以供参考

flash70

microyip 发表于 2018-7-22 10:02
[/code]

A列是空的还是报错

凌空一羽

flash70 发表于 2018-7-22 10:28
谢谢，楼二解决了，你的方法不行

h65ghfdas.zip (27.85 KB, 下载次数: 1)

2018-7-22 11:24 上传

点击文件名下载附件

microyip

flash70 发表于 2018-7-22 11:21
A列是空的还是报错

你下载了新文件了吗？没有问题的呀

YZC51

Function DEC2N(k, Optional x = 26) '十进制转任意进制(yzc51原创)
    Dim V, y, z, L, M
    y = Len(k)
    k = k + 675
    If y = 0 Then DEC2N = "": Exit Function
    n = Format(k \ 676, "000")
    For i = 1 To 2
        L = k Mod x
        V = Chr(L + 65) & V
        k = k \ x
    Next
    DEC2N = "PM" & n & V
End Function

Sub bh()
    Set SHT1 = Sheets("成品编号")
    N1 = SHT1.Cells(65536, 1).End(xlUp).Row
    ReDim ARR(1 To N1, 1 To 1)
    For j = 1 To N1
        ARR(j, 1) = DEC2N(j + 676)
    Next
    Range("b2").Resize(N1, 1) = ARR
End Sub

zhangru2199

有没有大神帮忙解决问题，不胜感激 怎样把Sheet1中 N 、O、AC、AD列的红色字体或红色背景的单元格所在的那一行依次复制到Sheet2中,要求不能有重复的行