Question

求一段excel vba代码！实现以下功能

在公司系统中导出的数据中，每一个单元格都有大量空格，导致导出来的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分，全部奉送！

Answer 1

不知 选择性粘贴 的哪一项能删除单元格中的空格？
我在前不久编了与你说的类似的宏。为了达到你的要求，可能要适当修改。请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

Answer 2

用代码没试过，提供以下手动方法（前提是原表格不含公式）：

1，打开原文件
2，新建一个文件
3，在新文件的A1单元格 =If(点到原文件A1="","",点到原文件A1)，回车
4，复制新A1,Ctrl+A,Ctrl+V，这样就用公式将原表中导入新表
5，新表中Ctrl+A,Ctrl+C，右建 - 选择性粘贴，数值

Answer 3

楼主的问题可行性蛮高滴，只是有人会用太多时间来百度空间做这个工作量不少的事么。