1、问题
需要打开某一文件夹下所有excel文件进行相同操作
2、代码
Sub FileOpen()
Dim File As String
Dim WB As Workbook
Dim strPath As String, strFileName As String
With Application.FileDialog(msoFileDialogFolderPicker)
'用户选择文件夹路径
If .Show Then strPath = .SelectedItems(1) Else Exit Sub
'如果用户为选择文件夹则退出程序
End With
If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
Application.ScreenUpdating = False '冻结屏幕,打开各个文件及关闭时屏幕不会晃瞎你
Application.DisplayAlerts = False '文件保存和关闭时提示关闭
File = Dir(strPath & "*.xlsx") '一次找寻路径中的excel文件,这里到底是.xlsx还是.xls,可以自己改
Do While File <> "" '当指定路径中由文件时进行循环
Set WB = Workbooks.Open(strPath & File) '打开符合要求的文件
Call NumArt '进行数据操作,根据自己的操作内容修改
ActiveWorkbook.Save '保存文件
ActiveWorkbook.Close '关闭文件
File = Dir '找寻下一个excel文件
Loop
Application.ScreenUpdating = True '解冻屏幕,让屏幕恢复正常刷新。和上面的那一句成对使用
Application.DisplayAlerts = True '恢复文件正常提示
End Sub
Sub NumArt()
Dim i As Integer
Dim a As Integer
Dim b As Integer
i = 1
Do While Range("a" & i) <> 0 '第一列单元格不为空继续执行
Range("b" & i) = Split(Range("a" & i).Value, "K")(1) 'b列数据为a列数据去除"K"
a = Split(Range("b" & i).Value, "+")(0) 'c列数据为b列数据去除".00"
b = Split(Range("b" & i).Value, "+")(1)
Range("c" & i) = a * 1000 + b
i = i + 1
Loop
Columns(1).Delete '删除第一列
End Sub
3、说明
包含两个函数FileOpen()
和NumArt()
,其中第一个函数是打开文件的主函数,第二个函数为数据操作函数,根据需求自行定义修改。