Sub 循环改工作簿和工作表名()
Dim myPath$, myFile$, sht As Worksheet
Dim s As String, s1 As String
Dim a, b
myPath = ThisWorkbook.Path '给路径变量赋值
myFile = Dir(myPath & "\*.xls") '用dir函数提取一个文件名
Application.ScreenUpdating = False '关闭屏幕刷新
Application.DisplayAlerts = False '禁用所有事件
Do While myFile <> "" '当文件名不为空循环
Workbooks.Open myPath & "\" & myFile '打开一个文件
For Each sht In Sheets '对这个文件的每个工作表(这里假设每个文件的工作表数不定)
s = sht.Name
a = Split(s, "_")
b = Split(a(2), "-")
a(2) = b(0) & b(1) & b(2)
s1 = a(0) & "_" & a(2)
sht.Name = s1
Next '继续循环打开文件的每个工作表,这里不会循环了,因为每个文件只有一张表
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "数据\" & s1 & ".xls"
ActiveWorkbook.Close savechanges:=True '关闭打开的工作簿
myFile = Dir '再用dir函数提取一个文件名
Loop '继续循环,重复上述过程
Application.DisplayAlerts = True ' 启用所有事件
Application.ScreenUpdating = True '打开屏幕刷新
End Sub
Dim myPath$, myFile$, sht As Worksheet
Dim s As String, s1 As String
Dim a, b
myPath = ThisWorkbook.Path '给路径变量赋值
myFile = Dir(myPath & "\*.xls") '用dir函数提取一个文件名
Application.ScreenUpdating = False '关闭屏幕刷新
Application.DisplayAlerts = False '禁用所有事件
Do While myFile <> "" '当文件名不为空循环
Workbooks.Open myPath & "\" & myFile '打开一个文件
For Each sht In Sheets '对这个文件的每个工作表(这里假设每个文件的工作表数不定)
s = sht.Name
a = Split(s, "_")
b = Split(a(2), "-")
a(2) = b(0) & b(1) & b(2)
s1 = a(0) & "_" & a(2)
sht.Name = s1
Next '继续循环打开文件的每个工作表,这里不会循环了,因为每个文件只有一张表
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "数据\" & s1 & ".xls"
ActiveWorkbook.Close savechanges:=True '关闭打开的工作簿
myFile = Dir '再用dir函数提取一个文件名
Loop '继续循环,重复上述过程
Application.DisplayAlerts = True ' 启用所有事件
Application.ScreenUpdating = True '打开屏幕刷新
End Sub