[已解决]請VBA老師幫忙解答下，謝謝，版主幫忙啊

yesong168 · 发表于 2013-7-5 12:14

對於VBA，我的程度僅會錄製一些簡單的，我錄製好的VBA，點一下可以簡單的處理一個excel的數據。
我想請教下老師們，怎麼才能把錄製好的VBA，點一下，可以自動處理很多個excel的數據，不要每個excel文檔都點一下。
有人建議加個循環遍歷進去，但是我不懂。
壓縮包循環遍歷文件夾裡有5個excel，就是簡單的整理一下那5個excel，最好就是做一個包含VBA的excel，在裡面有個選項，能選擇循環遍歷這個文件夾，然後點擊一下按鈕，就能直接整理所選文件夾裡所有的excel，然後在所選文件夾裡生成一個新的文件夾，裡麵包含整理好的數據，麻煩老師了，萬分感謝。

最佳答案

月排行榜 / 总排行榜

wp8680

2013-7-5 12:15

Sub 遍历文件()
Dim Filename As String, mypath As String, k As Integer
MsgBox "本工具作用：将把本工具所在文件夹下的并以“.xls”为后缀名的工作簿进行按要求处理！" & Chr(10) & Chr(10) & _
"处理结果将存在在本文件夹下的指定的《处理完毕》文件夹下面，并且原文件保持不变！" & Chr(10) & Chr(10) & _
"所以，请您把要处理的工作簿存在在工具所在文件夹下，并且尽量不要多层文件夹管理！" & Chr(10) & Chr(10) & _
"什么？没有理解？意思就是当文件夹下的子文件夹层数过多时，会导致代码运行错误！" & Chr(10) & Chr(10) & _
"什么？还不理解？那请你联系作者QQ399457850，无事勿扰！", , "糊涂提示："
Application.DisplayAlerts = Fasle '表示禁止显示提示和警告消息
Application.ScreenUpdating = False '表示停止屏幕更新
mypath = ThisWorkbook.Path & ""
Filename = Dir(mypath & "*.xls")
With ActiveSheet
.Range("A:A").ClearContents
.Range("A1") = "本次整理的工作表目录"
Do
k = k + 1
.Cells(k + 1, 1) = Filename
Workbooks.Open mypath & Filename
With ActiveSheet
.Range("A:A,G:K").Delete Shift:=xlToLeft
.Cells.EntireColumn.AutoFit
.Range("A2:A" & Range("b" & Cells.Rows.Count).End(xlUp).Row).FillDown
With .Range("B2:E" & Range("b" & Cells.Rows.Count).End(xlUp).Row)
.NumberFormat = "0"
.Value = .Value
End With
End With
ActiveWorkbook.SaveAs Filename:=mypath & "处理完毕" & Filename
ActiveWorkbook.Close
Filename = Dir
Loop Until Filename = "" Or Filename = "整理工具.xls"
End With
Application.DisplayAlerts = True '表示显示提示和警告消息
Application.ScreenUpdating = True '表求启用屏幕更新
End Sub

复制代码

循環遍歷.rar (37.49 KB, 下载次数: 9)

wp8680 · 发表于 2013-7-5 12:15

这个最佳答案由 wp8680 给出，感谢 wp8680 的回答。

单击隐藏图章

Sub 遍历文件()
Dim Filename As String, mypath As String, k As Integer
MsgBox "本工具作用：将把本工具所在文件夹下的并以“.xls”为后缀名的工作簿进行按要求处理！" & Chr(10) & Chr(10) & _
"处理结果将存在在本文件夹下的指定的《处理完毕》文件夹下面，并且原文件保持不变！" & Chr(10) & Chr(10) & _
"所以，请您把要处理的工作簿存在在工具所在文件夹下，并且尽量不要多层文件夹管理！" & Chr(10) & Chr(10) & _
"什么？没有理解？意思就是当文件夹下的子文件夹层数过多时，会导致代码运行错误！" & Chr(10) & Chr(10) & _
"什么？还不理解？那请你联系作者QQ399457850，无事勿扰！", , "糊涂提示："
Application.DisplayAlerts = Fasle '表示禁止显示提示和警告消息
Application.ScreenUpdating = False '表示停止屏幕更新
mypath = ThisWorkbook.Path & ""
Filename = Dir(mypath & "*.xls")
With ActiveSheet
.Range("A:A").ClearContents
.Range("A1") = "本次整理的工作表目录"
Do
k = k + 1
.Cells(k + 1, 1) = Filename
Workbooks.Open mypath & Filename
With ActiveSheet
.Range("A:A,G:K").Delete Shift:=xlToLeft
.Cells.EntireColumn.AutoFit
.Range("A2:A" & Range("b" & Cells.Rows.Count).End(xlUp).Row).FillDown
With .Range("B2:E" & Range("b" & Cells.Rows.Count).End(xlUp).Row)
.NumberFormat = "0"
.Value = .Value
End With
End With
ActiveWorkbook.SaveAs Filename:=mypath & "处理完毕" & Filename
ActiveWorkbook.Close
Filename = Dir
Loop Until Filename = "" Or Filename = "整理工具.xls"
End With
Application.DisplayAlerts = True '表示显示提示和警告消息
Application.ScreenUpdating = True '表求启用屏幕更新
End Sub

复制代码

循環遍歷.rar (37.49 KB, 下载次数: 9)

hwc2ycy · 发表于 2013-7-5 12:27

文件要怎么处理？
是五个合并还是？

wp8680 · 发表于 2013-7-5 13:56

我不是版主，{:021:}
不知能不能回答？{:101:}

		自动登录	找回密码
密码			注册