没有合适的资源?快使用搜索试试~ 我知道了~
批量转换Excel格式并合并所有工作簿下的所有工作表到同一个工作簿
需积分: 50 16 下载量 95 浏览量
2014-08-11
09:58:08
上传
评论
收藏 4KB TXT 举报
温馨提示
试读
3页
批量转换Workbooks格式方法一 批量转换Workbooks格式方法二 批量转换Excel格式并合并所有工作簿下的所有工作表到同一个工作簿 合并所有工作簿下的所有工作表到同一个工作簿
资源推荐
资源详情
资源评论
代码一或二:批量转换Workbooks格式方法,可实现功能为:如用户正使用EXCEL2007版本,或者是更高版本,可将excel2003,或更低版本的excel批量转换为用户当前所使用版本。
代码三:批量转换Excel格式并合并所有工作簿下的所有工作表到同一个工作簿,可实现功能为:如用户正使用EXCEL2007版本,或者是更高版本,可将excel2003,或更低版本的excel批量转换为用户当前所使用版本。同时将用户所选文件夹内的所有低版本(这里指EXCEL2003或更低版本)工作簿内的所有工作表全部移到同一个工作簿下,这样就避免了跨工作簿引用数据源,减少VBA批量计算时的搜索时间。
代码四: 将用户所选文件夹内的所有工作簿内的所有工作表全部移到同一个工作簿下,这样就避免了跨工作簿引用数据源,减少VBA批量计算时的搜索时间。(不需要转换低版本为高版本时使用)
'********************************代码一***************************************
Sub 批量转换Workbooks格式方法一()
Dim FilesToOpen
Dim x As Integer '定义变量
Dim NbName As String '新文件名
Dim folder As String '新文件存放位置
Application.ScreenUpdating = False '禁用刷新
FilesToOpen = Application.GetOpenFilename(FileFilter:="MicroSoft Excel文件(*.xls),*.xls", MultiSelect:=True, Title:="要转换的文件") '原文件路径
folder = "C:\Users\Administrator\Desktop\CCC02"
x = 1 '设置变量初值
While x <= UBound(FilesToOpen) '测试计数器的值
Workbooks.Open Filename:=FilesToOpen(x)
NbName = Mid(ActiveWorkbook.Name, 1, Len(ActiveWorkbook.Name) - 4) '截取原文件名
ActiveWorkbook.SaveAs folder & "\" & NbName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False '设定新文件名
x = x + 1 '将计数器的值加一
ActiveWorkbook.Close
Wend '当i>“UBound(FilesToOpen)”时则终止循环
Application.ScreenUpdating = True '恢复刷新
End Sub
'********************************代码二**********************************
Sub 批量转换Workbooks格式方法二()
Dim FilesToOpen
Dim x As Integer '定义变量
Dim NbName As String '新文件名
Dim folder As String '由用户选择新文件存放位置
Dim SrcBook As Workbook '原文件夹内文件集合
代码三:批量转换Excel格式并合并所有工作簿下的所有工作表到同一个工作簿,可实现功能为:如用户正使用EXCEL2007版本,或者是更高版本,可将excel2003,或更低版本的excel批量转换为用户当前所使用版本。同时将用户所选文件夹内的所有低版本(这里指EXCEL2003或更低版本)工作簿内的所有工作表全部移到同一个工作簿下,这样就避免了跨工作簿引用数据源,减少VBA批量计算时的搜索时间。
代码四: 将用户所选文件夹内的所有工作簿内的所有工作表全部移到同一个工作簿下,这样就避免了跨工作簿引用数据源,减少VBA批量计算时的搜索时间。(不需要转换低版本为高版本时使用)
'********************************代码一***************************************
Sub 批量转换Workbooks格式方法一()
Dim FilesToOpen
Dim x As Integer '定义变量
Dim NbName As String '新文件名
Dim folder As String '新文件存放位置
Application.ScreenUpdating = False '禁用刷新
FilesToOpen = Application.GetOpenFilename(FileFilter:="MicroSoft Excel文件(*.xls),*.xls", MultiSelect:=True, Title:="要转换的文件") '原文件路径
folder = "C:\Users\Administrator\Desktop\CCC02"
x = 1 '设置变量初值
While x <= UBound(FilesToOpen) '测试计数器的值
Workbooks.Open Filename:=FilesToOpen(x)
NbName = Mid(ActiveWorkbook.Name, 1, Len(ActiveWorkbook.Name) - 4) '截取原文件名
ActiveWorkbook.SaveAs folder & "\" & NbName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False '设定新文件名
x = x + 1 '将计数器的值加一
ActiveWorkbook.Close
Wend '当i>“UBound(FilesToOpen)”时则终止循环
Application.ScreenUpdating = True '恢复刷新
End Sub
'********************************代码二**********************************
Sub 批量转换Workbooks格式方法二()
Dim FilesToOpen
Dim x As Integer '定义变量
Dim NbName As String '新文件名
Dim folder As String '由用户选择新文件存放位置
Dim SrcBook As Workbook '原文件夹内文件集合
资源评论
idea889
- 粉丝: 0
- 资源: 1
上传资源 快速赚钱
- 我的内容管理 展开
- 我的资源 快来上传第一个资源
- 我的收益 登录查看自己的收益
- 我的积分 登录查看自己的积分
- 我的C币 登录后查看C币余额
- 我的收藏
- 我的下载
- 下载帮助
安全验证
文档复制为VIP权益,开通VIP直接复制
信息提交成功