求助批量改名问题

cushion1

各位高手，有空帮忙一下，首先谢谢你们啦！我编写的有缺陷。看附件 批量改名问题.zip (12.14 KB, 下载次数: 12)

2013-5-18 15:58 上传

点击文件名下载附件

最后的0是要的，我编写的是最后的0也去掉了。如原数据VB-100100，我想要的结果是VB-1100

grf1973

1. Sub tt1()
   
2.     With Sheets(1)
   
3.         b = .UsedRange.Rows.Count
   
4.         For i = 2 To b
   
5.             mstr = .Cells(i, 1)
   
6.             str1 = ""   'str1表示最后截取的“0000”
   
7.             For j = Len(mstr) To 1 Step -1
   
8.                 If Mid(mstr, j, 1) = "0" Then
   
9.                     str1 = str1 & "0"
   
10.                 Else
    
11.                     endp = j         'endp表示从后往前第一个非0的位置
    
12.                     Exit For
    
13.                 End If
    
14.             Next
    
15.             mstr = Left(mstr, endp)
    
16.             mstr = Replace(mstr, "0", "")
    
17.             .Cells(i, 3) = mstr & str1           '把最后截取的0加上
    
18.         Next
    
19.     End With
    
20. End Sub
    

复制代码

grf1973

str1不用累加，直接用Right函数就行。

1. Sub tt1()
   
2.     With Sheets(1)
   
3.         b = .UsedRange.Rows.Count
   
4.         For i = 2 To b
   
5.             mstr = .Cells(i, 1)
   
6.             For j = Len(mstr) To 1 Step -1
   
7.                 If Mid(mstr, j, 1) <> "0" Then
   
8.                     endp = j         'endp表示从后往前第一个非0的位置
   
9.                     str1 = Right(mstr, Len(mstr) - endp)
   
10.                     Exit For
    
11.                 End If
    
12.             Next
    
13.             mstr = Left(mstr, endp)
    
14.             mstr = Replace(mstr, "0", "")
    
15.             .Cells(i, 3) = mstr & str1           '把最后截取的0加上
    
16.         Next
    
17.     End With
    
18. End Sub
    

复制代码

cushion1

grf1973 发表于 2013-5-19 08:45
str1不用累加，直接用Right函数就行。

你好！很感谢你的帮助。
如果我想用以下代码做修整行吗？

1. Sub tt()
   
2. With Sheets(1)
   
3. b = .UsedRange.Rows.Count
   
4. Dim arr
   
5. For i = b To 2 Step -1
   
6. arr = Split(Cells(i, 1), "-")
   
7.     mstr = arr(1)
   
8.     str1 = arr(0): str2 = mstr
   
9.     For k = 1 To Len(mstr)
   
10.         c = Mid(mstr, k, 1)
    
11.         If c Like "[0]" Then               '如VB001-B0020，当去除B后两个0，循环到B0020中的2时，（if c like "[1-9]"）跳出循环，然后单元格得出值VB001-B20。
    
12.             str2 = Replace(str2, c, "")
    
13.         End If
    
14.     Next
    
15. Cells(i, 3) = str1 & "-" & str2
    
16. Next
    
17. End With
    
18. End Sub

复制代码

cushion1

grf1973 发表于 2013-5-19 08:45
str1不用累加，直接用Right函数就行。

我又在你身上学习到了东西，很感激！！！{:soso_e113:}，以下代码是我最终想要的。

1. Sub tt2()
   
2. Dim arr
   
3.     With Sheets(1)
   
4. 
   
5.         b = .UsedRange.Rows.Count
   
6.         For i = 2 To b
   
7.         arr = Split(Cells(i, 1), "-")
   
8.             mstr = arr(1)
   
9.             For j = Len(mstr) To 1 Step -1
   
10.                 If Mid(mstr, j, 1) <> "0" Then
    
11.                     endp = j         'endp表示从后往前第一个非0的位置
    
12.                     str1 = Right(mstr, Len(mstr) - endp)
    
13.                     Exit For
    
14.                 End If
    
15.             Next
    
16.             mstr = Left(mstr, endp)
    
17.             mstr = Replace(mstr, "0", "")
    
18.             .Cells(i, 3) = arr(0) & "-" & mstr & str1            '把最后截取的0加上
    
19.         Next
    
20.     End With
    
21. End Sub

复制代码

grf1973

你的意思是＂-"前面的不替换？

cushion1

grf1973 发表于 2013-5-19 10:13
你的意思是＂-"前面的不替换？

是的，我自己的那段代码，我就是想不到办法搞好