求写一个编号生成的宏，据是编号+1

o0star0o

tigertc 发表于 2019-3-18 17:18
sorry,没发现还有超过2位的.把NU行代码改成以下就可以了.
NU = Int(Right(Cells(myr, 8), Len(Cells(myr ...

嗯嗯，测试可以用了，谢谢!

o0star0o

tigertc 发表于 2019-3-18 17:18
sorry,没发现还有超过2位的.把NU行代码改成以下就可以了.
NU = Int(Right(Cells(myr, 8), Len(Cells(myr ...

另外哥们，你这个代码里面的8是什么意思啊？是最多只能读取上面8行吗？我发现好像编号间隔行数太多了，就生成不了了呢？

o0star0o

tigertc 发表于 2019-3-18 17:18
sorry,没发现还有超过2位的.把NU行代码改成以下就可以了.
NU = Int(Right(Cells(myr, 8), Len(Cells(myr ...

哥们，请求你下，就根据F1处的编号，然后在那上面+1再改下收字母就行了，F1处显示最后一个编号的公式非常准确，我长期测过的，今晚用了你的宏一晚上，发现在最后一个编号获取上有点不准，麻烦你帮我修改下，就采用F1位置的编号作为最后一个来加吧，这样很准确的
里面的公式是：

1. =LOOKUP(1,0/(ISNUMBER(FIND($H$1,$H$3:$H$8888))*ISERR(FIND(".",$H$3:$H$8888))=1),$H$3:$H$8888)

复制代码

非常感谢，麻烦您了！帮个忙！

o0star0o

tigertc 发表于 2019-3-18 17:18
sorry,没发现还有超过2位的.把NU行代码改成以下就可以了.
NU = Int(Right(Cells(myr, 8), Len(Cells(myr ...

等您回复！

o0star0o

tigertc 发表于 2019-3-18 17:18
sorry,没发现还有超过2位的.把NU行代码改成以下就可以了.
NU = Int(Right(Cells(myr, 8), Len(Cells(myr ...

能回复下下吗？

tigertc

应该是名字拼音和提定的字符有重复的吧,换一种方法你试下吧.

lsdongjh

你的公式不对的，需要另外处理一下

lsdongjh

1. Option Explicit
   
2. 
   
3. Sub Test()
   
4.     Dim SH As Worksheet
   
5.     Dim arr As Variant, lngRow As Long
   
6.     Dim strID As String, strName As String
   
7.    
   
8.     Set SH = Sheets("Sheet1")
   
9.     lngRow = SH.Range("H" & Rows.Count).End(xlUp).Row
   
10.     arr = SH.Range("H3:H" & lngRow)
    
11.     arr = Application.WorksheetFunction.Transpose(arr)
    
12.     strID = Trim(SH.Range("H1").Value)
    
13.     strName = Mid(Trim(SH.Range("E" & lngRow + 1).Value), 1, 2)
    
14.    
    
15.     If strID <> "" And strName <> "" Then
    
16.         SH.Range("H" & lngRow + 1).Value = GetPYByChar(strName) & strID & GetMaxIDBystr(strID, arr)
    
17.     End If
    
18.    
    
19. End Sub
    
20. 
    
21. 
    
22. Function GetMaxIDBystr(strSplit As String, arr As Variant) As Long
    
23.     Dim arrTemp As Variant, lngID As Long, lngMax As Long
    
24.     Dim arrResult As Variant
    
25.    
    
26.     arrTemp = Filter(arr, strSplit)
    
27.    
    
28.     If UBound(arrTemp) = -1 Then
    
29.         lngMax = 0
    
30.     Else
    
31.         ReDim arrResult(LBound(arrTemp) To UBound(arrTemp)) As Long
    
32.         For lngID = LBound(arrTemp) To UBound(arrTemp)
    
33.             arrResult(lngID) = Split(arrTemp(lngID), strSplit)(1)
    
34.         Next
    
35.         lngMax = Application.WorksheetFunction.Max(arrResult)
    
36.     End If
    
37.    
    
38.     GetMaxIDBystr = lngMax + 1
    
39. End Function
    
40. 
    
41. Function GetPYByChar(strChar As String) As String
    
42.     Dim lngID As Long, lngChar As Long
    
43.     Dim strTemp As String, strResult As String
    
44.    
    
45.     For lngID = 1 To Len(strChar)
    
46.         strTemp = Mid(strChar, lngID, 1)
    
47.         lngChar = 65536 + Asc(strTemp)
    
48.         Select Case lngChar
    
49.             Case 45217 To 45252: strTemp = "A"
    
50.             Case 45253 To 45760: strTemp = "B"
    
51.             Case 45761 To 46317: strTemp = "C"
    
52.             Case 46318 To 46825: strTemp = "D"
    
53.             Case 46826 To 47009: strTemp = "E"
    
54.             Case 47010 To 47296: strTemp = "F"
    
55.             Case 47297 To 47613: strTemp = "G"
    
56.             Case 47614 To 48118: strTemp = "H"
    
57.             Case 48119 To 49061: strTemp = "J"
    
58.             Case 49062 To 49323: strTemp = "K"
    
59.             Case 49324 To 49895: strTemp = "L"
    
60.             Case 49896 To 50370: strTemp = "M"
    
61.             Case 50371 To 50613: strTemp = "N"
    
62.             Case 50614 To 50621: strTemp = "O"
    
63.             Case 50622 To 50905: strTemp = "P"
    
64.             Case 50906 To 51386: strTemp = "Q"
    
65.             Case 51387 To 51445: strTemp = "R"
    
66.             Case 51446 To 52217: strTemp = "S"
    
67.             Case 52218 To 52697: strTemp = "T"
    
68.             Case 52698 To 52979: strTemp = "W"
    
69.             Case 52980 To 53640: strTemp = "X"
    
70.             Case 53689 To 54480: strTemp = "Y"
    
71.             Case 54481 To 62289: strTemp = "Z"
    
72.         End Select
    
73.         strResult = strResult & strTemp
    
74.     Next
    
75.     GetPYByChar = strResult & "ID"
    
76. End Function
    
77. 
    
78. 
    

复制代码