[已解决]如何用VBA代码实现自动提取字母并填入单元格

cfyhqy

我想用VBA代码自动提取字符串前面的字母，并按要求填入指定单元格，如附件所示。 中村图书.rar (28.38 KB, 下载次数: 22)

2013-4-12 14:30 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

lisachen

2013-4-12 14:45

1. Sub test()
   
2.     Dim arr
   
3.     irow = [c65536].End(3).Row
   
4. 
   
5.     arr = Range("c2:c" & irow)
   
6.     k = 1
   
7.     arr(1, 1) = Left(arr(1, 1), 1) & Format(k, "-0000")
   
8.     For x = 2 To UBound(arr)
   
9.         k = k + 1
   
10.         If Left(arr(x, 1), 1) = Left(arr(x - 1, 1), 1) Then
    
11.             arr(x, 1) = Left(arr(x, 1), 1) & Format(k, "-0000")
    
12.         Else
    
13.             k = 1
    
14.             arr(x, 1) = Left(arr(x, 1), 1) & Format(k, "-0000")
    
15.         End If
    
16.     Next x
    
17.     Range("d2").Resize(UBound(arr)) = arr
    
18. End Sub

复制代码

跳转到最佳答案楼层

lisachen

1. Sub test()
   
2.     Dim arr
   
3.     irow = [c65536].End(3).Row
   
4. 
   
5.     arr = Range("c2:c" & irow)
   
6.     k = 1
   
7.     arr(1, 1) = Left(arr(1, 1), 1) & Format(k, "-0000")
   
8.     For x = 2 To UBound(arr)
   
9.         k = k + 1
   
10.         If Left(arr(x, 1), 1) = Left(arr(x - 1, 1), 1) Then
    
11.             arr(x, 1) = Left(arr(x, 1), 1) & Format(k, "-0000")
    
12.         Else
    
13.             k = 1
    
14.             arr(x, 1) = Left(arr(x, 1), 1) & Format(k, "-0000")
    
15.         End If
    
16.     Next x
    
17.     Range("d2").Resize(UBound(arr)) = arr
    
18. End Sub

复制代码

hwc2ycy

1. =LEFT(C2)&TEXT(ROW(A1),"-0000")

复制代码

hwc2ycy

还要用VBA做什么，一个函数下拉就能完成的事。

无聊的疯子

刚才看位置看错了，公式用在 F 列

1. 
   
2. =IF(COUNTIF($F$1:F1,LEFT(C2,1))=0,LEFT(C2,1),"")
   

复制代码

在E2使用下面的公式，直接拉

1. <p>
   
2. =IF(COUNTIF($F$1:F1,LEFT(D2,1))=0,LEFT(D2,1),"")</p><p> </p>

复制代码

无聊的疯子

D 列样式的数据，直接用公式生成在 F列

1. 
   
2. =IF(LEFT(C2,1)=LEFT(F1,1),LEFT(C2,1)&TEXT(MID(F1,FIND("-",F1,1)+1,4)+1,"-0000"),LEFT(C2,1)&"-0001")
   

复制代码