查找空缺号码填入另一列上

xyh2732

请问如何可以用代码实现以下功能，在不考虑文件类型的扩展名的情况下“.TIF”,把空缺的号码显示在C列上。比如左边的A列却少了PPA12120009，就在C列填写PPA12120009

csmctjg

1. 
   
2. Sub aa()
   
3. Dim i%, x%
   
4. For i = 2 To [A65536].End(3).Row
   
5.     x = Mid(Cells(i, 1), 8, 4)
   
6.     Do Until Mid(Cells(i, 1), 4, 4) <> Mid(Cells(i + 1, 1), 4, 4)
   
7.         If Mid(Cells(i, 1), 8, 4) <> x Then
   
8.             Do Until Mid(Cells(i, 1), 8, 4) = x
   
9.                 Range("C" & [C65536].End(3).Row + 1) = Left(Cells(i, 1), 7) & Format(x, "0000")
   
10.                 x = x + 1
    
11.             Loop
    
12.         End If
    
13.         i = i + 1
    
14.         x = x + 1
    
15.     Loop
    
16. Next
    
17. End Sub
    

复制代码

xyh2732

csmctjg 发表于 2013-4-24 07:42

非常感谢您的帮忙，我添加了一些前面没有英文名称的 就出错了（比如 12030001.TIF ），请帮忙看看有没有办法解决，谢谢！

csmctjg

xyh2732 发表于 2013-4-24 09:14
非常感谢您的帮忙，我添加了一些前面没有英文名称的 就出错了（比如 12030001.TIF ），请帮忙看看有没有办 ...

1. Sub aa()
   
2. Dim i%, x%
   
3. For i = 2 To [A65536].End(3).Row
   
4.     x = Right(Split(Cells(i, 1), ".")(0), 4)
   
5.     Do Until Left(Right(Split(Cells(i, 1), ".")(0), 8), 4) <> Left(Right(Split(Cells(i + 1, 1), ".")(0), 8), 4)
   
6.         If Right(Split(Cells(i, 1), ".")(0), 4) <> x Then
   
7.             Do Until Right(Split(Cells(i, 1), ".")(0), 4) = x
   
8.                 Range("C" & [C65536].End(3).Row + 1) = Left(Cells(i, 1), Len(Split(Cells(i, 1), ".")(0)) - 4) & Format(x, "0000")
   
9.                 x = x + 1
   
10.             Loop
    
11.         End If
    
12.         i = i + 1
    
13.         x = x + 1
    
14.         If i = [A65536].End(3).Row Then Exit For
    
15.     Loop
    
16. Next
    
17. End Sub

复制代码