[已解决]VB批量重命名~~求助各位大大们~

lnm3qzhj · 发表于 2014-6-20 18:29

在同一文件中，有“广东－广州－A－1.csv”、“广东－深圳－B－2.csv”、“广东－珠海－C－3.csv”、等多个文件，用VB批量重命名为“广东1.csv”、“广东2.csv”、“广东3csv”等，向各位老师，大虾请教！！其中文件名中的“－*－*－”为变量，不一定是上述字符，求代码。万分感激~~~~

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2014-6-20 19:43

Sub demo1()
Dim objDic As Object
Dim strPath$, strFile$, strTemp$
Set objDic = CreateObject("scripting.dictionary")
strPath = ThisWorkbook.Path & ""
strFile = Dir(strPath & "*.xls")
Do While Len(strFile)
If strFile <> ThisWorkbook.Name Then
If strFile Like "*-*-*-*.*" Then
strTemp = Left(strFile, InStr(strFile, "-") - 1)
objDic(strTemp) = objDic(strTemp) + 1
Name strPath & strFile As strPath & strTemp & objDic(strTemp) & Mid(strFile, InStrRev(strFile, "."))
End If
End If
strFile = Dir
Loop
Set objDic = Nothing
End Sub

复制代码

没有测试，另外，如果重复运行，应该会产生错误，而且有BUG。

跳转到最佳答案楼层

hwc2ycy · 发表于 2014-6-20 19:43

这个最佳答案由 hwc2ycy 给出，感谢 hwc2ycy 的回答。

单击隐藏图章

Sub demo1()
Dim objDic As Object
Dim strPath$, strFile$, strTemp$
Set objDic = CreateObject("scripting.dictionary")
strPath = ThisWorkbook.Path & ""
strFile = Dir(strPath & "*.xls")
Do While Len(strFile)
If strFile <> ThisWorkbook.Name Then
If strFile Like "*-*-*-*.*" Then
strTemp = Left(strFile, InStr(strFile, "-") - 1)
objDic(strTemp) = objDic(strTemp) + 1
Name strPath & strFile As strPath & strTemp & objDic(strTemp) & Mid(strFile, InStrRev(strFile, "."))
End If
End If
strFile = Dir
Loop
Set objDic = Nothing
End Sub

复制代码

没有测试，另外，如果重复运行，应该会产生错误，而且有BUG。

lnm3qzhj · 发表于 2014-6-20 20:19

已成功验证，谢谢版主大大~~~

		自动登录	找回密码
密码			注册