求一段excel vba代码!实现以下功能
在公司系统中导出的数据中,每一个单元格都有大量空格,导致导出来的excel很大,经过试验,把这个文件打开,然后选择性粘贴到一张新建的excel表中就可以大大减小excel...
在公司系统中导出的数据中,每一个单元格都有大量空格,导致导出来的excel很大,经过试验,把这个文件打开,然后选择性粘贴到一张新建的excel表中就可以大大减小excel的大小,现在想求一段代码实现以下功能!
我把导出来的excel表都放在一个文件夹下,然后在一张excel表中运行代码,实现以下功能:
1、在主excel中点击运行按钮,打开目标文件夹中的一个excel文件;
2、复制这个excel中的数据;
3、新建一个excel表;
4、将数据粘贴到新建的excel表中;
5、提取原excel表的名称;
6、关闭原excel表;
7、保存新建的excel表;
8、用原excel表的名称命名新表;
9、提示覆盖原表时点“是”;
10、重复以上步骤;
直至完成!
还有一个问题,就是减肥完成以后,如何再用一个代码处理刚减完肥的文件,如合并单元格什么的!
我现在只有30分,全部奉送! 展开
我把导出来的excel表都放在一个文件夹下,然后在一张excel表中运行代码,实现以下功能:
1、在主excel中点击运行按钮,打开目标文件夹中的一个excel文件;
2、复制这个excel中的数据;
3、新建一个excel表;
4、将数据粘贴到新建的excel表中;
5、提取原excel表的名称;
6、关闭原excel表;
7、保存新建的excel表;
8、用原excel表的名称命名新表;
9、提示覆盖原表时点“是”;
10、重复以上步骤;
直至完成!
还有一个问题,就是减肥完成以后,如何再用一个代码处理刚减完肥的文件,如合并单元格什么的!
我现在只有30分,全部奉送! 展开
3个回答
展开全部
不知 选择性粘贴 的哪一项能删除单元格中的空格?
我在前不久编了与你说的类似的宏。为了达到你的要求,可能要适当修改。请hi 我
'新建一Excel文件,把代码粘进去,执行,按提示操作
Sub 删除空格()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
BkName = ActiveWorkbook.Name
MsgBox "请选择 Excel文件 的路径!"
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
folderspec = .SelectedItems(1)
If Right(SavePath, 1) <> "\" Then
folderspec = folderspec + "\"
End If
End With
Dim fs, f, f1, fc
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.Files
sc = 1
Dim ran As Range
For Each f1 In fc
If Right(f1.Name, 3) = "xls" Then
fName = folderspec + f1.Name
' sName = Left(f1.Name, Len(f1.Name) - 4)
Workbooks.Open fName
For s = 1 To Sheets.Count
Sheets(s).Select
Set ran = Cells(1, 1).CurrentRegion
Row = ran.Rows.Count
col = ran.Columns.Count
For r = 1 To Row
For c = 1 To col
Cells(r, c) = Trim(Cells(r, c))
Next c
Next r
Next s
ActiveWorkbook.Save
ActiveWorkbook.Close
End If
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "空格删除完毕!"
End Sub
我在前不久编了与你说的类似的宏。为了达到你的要求,可能要适当修改。请hi 我
'新建一Excel文件,把代码粘进去,执行,按提示操作
Sub 删除空格()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
BkName = ActiveWorkbook.Name
MsgBox "请选择 Excel文件 的路径!"
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
folderspec = .SelectedItems(1)
If Right(SavePath, 1) <> "\" Then
folderspec = folderspec + "\"
End If
End With
Dim fs, f, f1, fc
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.Files
sc = 1
Dim ran As Range
For Each f1 In fc
If Right(f1.Name, 3) = "xls" Then
fName = folderspec + f1.Name
' sName = Left(f1.Name, Len(f1.Name) - 4)
Workbooks.Open fName
For s = 1 To Sheets.Count
Sheets(s).Select
Set ran = Cells(1, 1).CurrentRegion
Row = ran.Rows.Count
col = ran.Columns.Count
For r = 1 To Row
For c = 1 To col
Cells(r, c) = Trim(Cells(r, c))
Next c
Next r
Next s
ActiveWorkbook.Save
ActiveWorkbook.Close
End If
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "空格删除完毕!"
End Sub
本回答被提问者采纳
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
用代码没试过,提供以下手动方法(前提是原表格不含公式):
1,打开原文件
2,新建一个文件
3,在新文件的A1单元格 =If(点到原文件A1="","",点到原文件A1),回车
4,复制新A1,Ctrl+A,Ctrl+V,这样就用公式将原表中导入新表
5,新表中Ctrl+A,Ctrl+C,右建 - 选择性粘贴,数值
1,打开原文件
2,新建一个文件
3,在新文件的A1单元格 =If(点到原文件A1="","",点到原文件A1),回车
4,复制新A1,Ctrl+A,Ctrl+V,这样就用公式将原表中导入新表
5,新表中Ctrl+A,Ctrl+C,右建 - 选择性粘贴,数值
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
楼主的问题可行性蛮高滴,只是有人会用太多时间来百度空间做这个工作量不少的事么。
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询