[已解决]批量修改文件夹编号的问题

阿柔

附件 批量修改文件夹编号.rar (6.48 KB, 下载次数: 15)

2014-5-10 09:57 上传

点击文件名下载附件
谢谢！

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2014-5-10 10:19

1. Sub demo1()
   
2.     Dim strPath$, strName$
   
3.     Dim l As Byte, i As Byte, j As Byte
   
4.     Dim strNewName$
   
5.     strPath = ThisWorkbook.Path & Application.PathSeparator
   
6.     strName = Dir(strPath & "*.*", vbDirectory)
   
7.     Do While Len(strName)
   
8.         strNewName = ""
   
9.         If (GetAttr(strPath & strName) And vbDirectory) = vbDirectory Then
   
10.             l = Val(strName)
    
11.             If l Then
    
12.                 i = l \ 26
    
13.                 j = l Mod 26
    
14.                 If i Then strNewName = strNewName & Chr(64 + i)
    
15.                 If j Then strNewName = strNewName & Chr(64 + j)
    
16.                 Name strPath & strName As strPath & strNewName
    
17.                 Debug.Print strName, strNewName
    
18.             End If
    
19.         End If
    
20.         strName = Dir
    
21.     Loop
    
22.     MsgBox "重命名完成"
    
23. End Sub

复制代码

上面有点问题，没注意四舍五入的问题了。

跳转到最佳答案楼层

hwc2ycy

1. Sub demo1()
   
2.     Dim strPath$, strName$
   
3.     Dim l As Byte, i As Byte, j As Byte
   
4.     Dim strNewName$
   
5.     strPath = ThisWorkbook.Path & Application.PathSeparator
   
6.     strName = Dir(strPath & "*.*", vbDirectory)
   
7.     Do While Len(strName)
   
8.         strNewName = ""
   
9.         If (GetAttr(strPath & strName) And vbDirectory) = vbDirectory Then
   
10.             l = Val(strName)
    
11.             If l Then
    
12.                 i = l / 26
    
13.                 j = l Mod 26
    
14.                 If i Then strNewName = strNewName & Chr(64 + i)
    
15.                 If j Then strNewName = strNewName & Chr(64 + j)
    
16.                 Name strPath & strName As strPath & strNewName
    
17.             End If
    
18.         End If
    
19.         strName = Dir
    
20.     Loop
    
21.     MsgBox "重命名完成"
    
22. End Sub
    

复制代码

hwc2ycy

1. Sub demo1()
   
2.     Dim strPath$, strName$
   
3.     Dim l As Byte, i As Byte, j As Byte
   
4.     Dim strNewName$
   
5.     strPath = ThisWorkbook.Path & Application.PathSeparator
   
6.     strName = Dir(strPath & "*.*", vbDirectory)
   
7.     Do While Len(strName)
   
8.         strNewName = ""
   
9.         If (GetAttr(strPath & strName) And vbDirectory) = vbDirectory Then
   
10.             l = Val(strName)
    
11.             If l Then
    
12.                 i = l \ 26
    
13.                 j = l Mod 26
    
14.                 If i Then strNewName = strNewName & Chr(64 + i)
    
15.                 If j Then strNewName = strNewName & Chr(64 + j)
    
16.                 Name strPath & strName As strPath & strNewName
    
17.                 Debug.Print strName, strNewName
    
18.             End If
    
19.         End If
    
20.         strName = Dir
    
21.     Loop
    
22.     MsgBox "重命名完成"
    
23. End Sub

复制代码

上面有点问题，没注意四舍五入的问题了。

hwc2ycy

刚刚想到个事，如果文件名前面有-号，这个代码估计还得改进下。

阿柔

hwc2ycy 发表于 2014-5-10 10:28
刚刚想到个事，如果文件名前面有-号，这个代码估计还得改进下。

老师您好，代码只能修改到26，提示：文件已存在。

阿柔

hwc2ycy 发表于 2014-5-10 10:28
刚刚想到个事，如果文件名前面有-号，这个代码估计还得改进下。

我把里面的26改为49也是如此，只能改到26，然后跳出提示：文件已存在。

hwc2ycy

阿柔 发表于 2014-5-10 10:37
老师您好，代码只能修改到26，提示：文件已存在。

==,我再测下哈。你是1到多少？

阿柔

hwc2ycy 发表于 2014-5-10 10:40
==,我再测下哈。你是1到多少？

01 02 03 04到49，前面没有-号。

hwc2ycy

1. Sub demo1()
   
2.     Dim strPath$, strName$
   
3.     Dim l As Byte, i As Byte, j As Byte
   
4.     Dim strNewName$
   
5.     strPath = ThisWorkbook.Path & Application.PathSeparator
   
6.     strName = Dir(strPath & "*.*", vbDirectory)
   
7.     Do While Len(strName)
   
8.         strNewName = ""
   
9.         If (GetAttr(strPath & strName) And vbDirectory) = vbDirectory Then
   
10.             l = Val(strName)
    
11.             If l Then
    
12.                 i = l \ 27
    
13.                 j = (l - 1) Mod 26 + 1
    
14.                 If i Then strNewName = strNewName & Chr(64 + i)
    
15.                 If j Then strNewName = strNewName & Chr(64 + j)
    
16.                 Name strPath & strName As strPath & strNewName
    
17.                 Debug.Print strName, strNewName
    
18.             End If
    
19.         End If
    
20.         strName = Dir
    
21.     Loop
    
22.     MsgBox "重命名完成"
    
23. End Sub

复制代码

不好意思，没有测试到其他的数据，刚测了从1-50.

阿柔

hwc2ycy 发表于 2014-5-10 10:46
不好意思，没有测试到其他的数据，刚测了从1-50.

谢谢老师，已搞定。