Excel VBA程序开发

14587 Lv.2

2025-11-9 14:58 关注
本人以前在本论坛中看到过一个文件重命名的工具，非常好用，但在实际操作中，想更进一步应用，请大侠帮忙，谢谢！本人的要求是，在点重命名时，能够快速命名并移动到指定的夹中的文件里。注意，新的命名好多名字是相同的。工具是从本论坛下载的，有冒犯的地方还请原谅！！！

文件重命名好.zip   2025-11-9 14:56 上传

455.45 KB, 下载次数: 9

赏
236阅读
8回复 倒序

ykcbf1100 Lv.7 2楼

2025-11-9 17:39
原代码应该不适用此题情况，代码重写一个。

附件供参考。。。

文件重命名好.zip   2025-11-9 17:39 上传

456.43 KB, 下载次数: 8

ykcbf1100 Lv.7 3楼

2025-11-9 17:40
  1. Sub ykcbf()   '//2025.11.9
  2.     Application.ScreenUpdating = False
  3.     Set fso = CreateObject("Scripting.FileSystemObject")
  4.     p = ThisWorkbook.Path & Application.PathSeparator
  5.     p1 = p & "测试数据" & Application.PathSeparator
  6.     p2 = p & "移动到指定文件中" & Application.PathSeparator
  7.     r = Cells(Rows.Count, 1).End(xlUp).Row
  8.     Arr = Range("a1").Resize(r, 9).Value
  9.     For i = 2 To UBound(Arr)
  10.         If Len(Arr(i, 9) & "") Then
  11.             p3 = p2 & Arr(i, 9) & Application.PathSeparator
  12.             fn1 = p1 & Arr(i, 2) & Arr(i, 4)
  13.             fn2 = p3 & Arr(i, 3) & Arr(i, 4)
  14.             fso.MoveFile fn1, fn2
  15.         End If
  16.     Next
  17.     Application.ScreenUpdating = True
  18.     MsgBox "OK！"
  19. End Sub


14587 楼主 4楼

2025-11-9 19:13
引用: ykcbf1100 发表于 2025-11-9 17:40

谢谢啦，完美解决，

14587 楼主 5楼

2025-11-10 11:03
大侠帮忙下，超过4人，25张后就不能运行，请帮修改下，谢谢！

ykcbf1100 Lv.7 6楼

2025-11-10 14:59
引用: 14587 发表于 2025-11-10 11:03
大侠帮忙下，超过4人，25张后就不能运行，请帮修改下，谢谢！

上附件看看。

14587 楼主 7楼

2025-11-10 16:43
我换台电脑试试，主要涉及到一些敏感信息，不好发

ykcbf1100 Lv.7 8楼

2025-11-10 19:18
引用: 14587 发表于 2025-11-10 16:43
我换台电脑试试，主要涉及到一些敏感信息，不好发

可以摸拟一些数据。

14587 楼主 9楼

2025-11-10 22:08
师傅，是电脑问题，在家里一切正常！！！

已显示全部内容

高级模式
插入