[已解决]怎么填充数据？

grf1973

1. Sub tt()
   
2.     arr = [g10].CurrentRegion
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     Set d1 = CreateObject("scripting.dictionary")
   
5.     x = [h65536].End(3)   'H列最下面数据
   
6.     s = Left(x, 3)        '前三位字母：XYZ
   
7.     a = Val(Mid(x, 4, 3))     '中三位值：629
   
8.     For i = 2 To UBound(arr)
   
9.         If Len(arr(i, 2)) = 0 Then   '去掉头上已填充数据的单元格
   
10.             x = arr(i, 1)
    
11.             If Not d.exists(x) Then k = k + 1: d1(x) = a + k
    
12.             d(x) = d(x) + 1
    
13.             arr(i, 2) = s & d1(x) & d(x)
    
14.         End If
    
15.     Next
    
16.     For i = 2 To UBound(arr)
    
17.         x = arr(i, 1)
    
18.         If d(x) = 1 Then Mid(arr(i, 2), Len(arr(i, 2)), 1) = "0"
    
19.     Next
    
20.     [g10].CurrentRegion = arr
    
21. End Sub
    

复制代码

grf1973

请看附件。