设为首页收藏本站

 找回密码
 立即注册

只需一步,快速开始

搜索
楼主: 周剑君

EXCEL文件\文件夹更名-批量重命名文件名,支持反悔功能(2024.1.17更新)

[复制链接]
累计签到:61 天
连续签到:2 天
灌水成绩
3
246
4274
主题
帖子
积分

等级头衔

ID : 879

助理工程师

积分成就 测量币 : 4274
在线时间 : 0 小时
注册时间 : 2025-12-5
最后登录 : 2026-8-2

勋章
UID勋章
发表于 2024-1-18 07:45:00 | 显示全部楼层 IP:北京
Sub 文件重命名()
    Dim Arr, i%, oldName$, newName$
    On Error Resume Next
    Sheet1.Activate
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    If Range("A2") = "" Then MsgBox "没有数据", 64, "提示": Exit Sub
    If Range("B1") = "原来的文件名" Then MsgBox "你已经重命名过文件了", 64, "提示": Exit Sub
    Arr = Range("A1").CurrentRegion
'    For i = 2 To UBound(Arr)
'        If Len(Arr(i, 3)) = 0 Then MsgBox "请将第  " & i & "  行的新文件名填写完整!", 64, "提示": Exit Sub
'    Next
    For i = 2 To UBound(Arr)
        oldName = Arr(i, 1) & Arr(i, 2) & Arr(i, 4)
        newName = Arr(i, 1) & Arr(i, 3) & Arr(i, 4)
        If Len(Arr(i, 3))  0 Then
            Name oldName As newName
        End If
    Next
    Range("B1") = "原来的文件名"
    Range("C1") = "现在的文件名"
    MsgBox "重命名完成,请查看", 64, "提示"
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
回复

使用道具 举报

快速回复换一批
顶顶顶
好贴帮顶
2333333333
果断收藏! 找了很久的资源/教程,终于在这里找到了,感谢站长/楼主! 💾🔥
前排围观! 搬好小板凳,坐看大佬们在线battle技术。 🪑🍿
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

Archiver|小黑屋|精密测量技术论坛 ( 桂ICP备2026007449号-1 )

GMT+8, 2026-9-15 03:22 , Processed in 0.558475 second(s), 52 queries .

Powered by 精密测量技术论坛

© 2025-2026 联系站长

快速回复 返回顶部 返回列表