这是我在这个平台上的第一个问题，所以请原谅我可能犯的任何错误。 我有几个excel工作簿，我想对所有这些工作簿进行精确的工作表和确切的单元格的多次精确更改，但它们太多了，无法单独完成。 我使用其中一个工作簿记录了我要在宏中进行的所有更改;
Sub Macro1()
Range("W4:X4").Select
ActiveCell.FormulaR1C1 = "OFF -PEAK GEM(MW)"
Range("J33:M33").Select
ActiveCell.FormulaR1C1 = "Hz"
Range("B33:I33").Select
ActiveCell.FormulaR1C1 = "DETAILS"
Range("R34:X34").Select
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
Range("R35:X35").Select
Selection.Cut
Range("R34").Select
ActiveSheet.Paste
Range("K68:L123").Select
Selection.Delete Shift:=xlToLeft
Range("K68:L68").Select
ActiveCell.FormulaR1C1 = "UNITS ON BAR"
Range("V178").Select
ActiveCell.FormulaR1C1 = "EXPECTED RESERVE"
Range("V179:V182").Select
End Sub
我在另一个不同的未经修改的工作簿中运行了这个宏，它运行得很好。 我是使用VBA的新手，但我能够在线找到一个代码块，可以更改指定目录中的多个excel文件;
Sub ChangeFiles()
Dim MyPath As String
Dim MyFile As String
Dim dirName As String
Dim wks As Worksheet
' Change directory path as desired
dirName = "c:\myfiles\"
MyPath = dirName & "*.xlsx"
MyFile = Dir(MyPath)
If MyFile > "" Then MyFile = dirName & MyFile
Do While MyFile <> ""
If Len(MyFile) = 0 Then Exit Do
Workbooks.Open MyFile
With ActiveWorkbook
For Each wks In .Worksheets
' Specify the change to make
wks.Range("A1").Value = "A1 Changed"
Next
End With
ActiveWorkbook.Close SaveChanges:=True
MyFile = Dir
If MyFile > "" Then MyFile = dirName & MyFile
Loop
End Sub
我编辑它以满足我的需求;
Sub ChangeFiles()
Dim MyPath As String
Dim MyFile As String
Dim dirName As String
Dim wks As Worksheet
Set wks = ActiveWorkbook.Worksheets("SHEET X")
' Change directory path as desired
dirName = "/Users/Account/Desktop/Directory 1/Directory 2/"
MyPath = dirName & "*.xls"
MyFile = Dir(MyPath)
If MyFile > "" Then MyFile = dirName & MyFile
Do While MyFile <> ""
If Len(MyFile) = 0 Then Exit Do
Workbooks.Open MyFile
With ActiveWorkbook
For Each wks In ActiveWorkbook.Worksheets
' Specify the change to make
wks.Range("W4:X4").Select
ActiveCell.FormulaR1C1 = "OFF -PEAK GEM(MW)"
wks.Range("J33:M33").Select
ActiveCell.FormulaR1C1 = "Hz"
wks.Range("B33:I33").Select
ActiveCell.FormulaR1C1 = "DETAILS"
wks.Range("R34:X34").Select
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
wks.Range("R35:X35").Select
Selection.Cut
wks.Range("R34").Select
ActiveSheet.Paste
wks.Range("K68:L123").Select
Selection.Delete Shift:=xlToLeft
wks.Range("K68:L68").Select
ActiveCell.FormulaR1C1 = "UNITS ON BAR"
wks.Range("V178").Select
ActiveCell.FormulaR1C1 = "EXPECTED RESERVE"
wks.Range("V179:V182").Select
Next
End With
ActiveWorkbook.Close SaveChanges:=True
MyFile = Dir
If MyFile > "" Then MyFile = dirName & MyFile
Loop
End Sub
我跑了它并没有做任何事情并且没有返回任何错误。我真的在我的智慧结束，我真的很感激任何帮助。 P.S我是mac用户
答案 0 :(得分：2)
好吧，120个同时打开的标签（不开玩笑，我算了）和两个不眠之夜，我终于找到了解决方案。 注意：这仅适用于MAC ，显然我认为Dir在Mac上无法运行，感谢@Jeeped指出这一点，所以对于其他Mac用户来说，我的问题，这就是我所做的：
Option Explicit
'Important: this Dim line must be at the top of your module
Dim dirName As String
Sub ChangeFiles()
Dim MySplit As Variant
Dim FileIndirName As Long
Dim wks As Worksheet
'Clear dirName to be sure that it not return old info if no files are found
dirName = ""
Call GetFilesOnMacWithOrWithoutSubfolders(Level:=1, ExtChoice:=1, FileFilterOption:=0, FileNameFilterStr:="SearchString")
If dirName <> "" Then
With Application
.ScreenUpdating = False
End With
MySplit = Split(dirName, Chr(13))
For FileIndirName = LBound(MySplit) To UBound(MySplit)
Workbooks.Open (MySplit(FileIndirName))
Set wks = ActiveWorkbook.Worksheets("SHEET X")
With wks
.Range("W4:X4") = "OFF -PEAK GEM(MW)"
.Range("J33:M33") = "Hz"
.Range("B33:I33") = "DETAILS"
.Range("R34:X34").EntireRow.Insert Shift:=xlShiftDown
.Range("R35:X35").Cut Destination:=Range("R34")
.Range("K68:L123").Delete Shift:=xlToLeft
.Range("K68:L68") = "UNITS ON BAR"
.Range("V178") = "EXPECTED RESERVE"
End With
ActiveWorkbook.Close SaveChanges:=True
Next FileIndirName
With Application
.ScreenUpdating = True
End With
Else
MsgBox "Sorry no files that match your criteria, A 0 files result can be due to Apple sandboxing: Try using the Browse button to re-select the folder."
With Application
.ScreenUpdating = True
End With
End If
MsgBox "Done!"
End Sub
'*******Function that do all the work that will be called by the macro*********
Function GetFilesOnMacWithOrWithoutSubfolders(Level As Long, ExtChoice As Long, _
FileFilterOption As Long, FileNameFilterStr As String)
'Ron de Bruin,Version 4.0: 27 Sept 2015
'http://www.rondebruin.nl/mac.htm
'Thanks to DJ Bazzie Wazzie and Nigel Garvey(posters on MacScripter)
Dim ScriptToRun As String
Dim folderPath As String
Dim FileNameFilter As String
Dim Extensions As String
On Error Resume Next
folderPath = MacScript("choose folder as string")
If folderPath = "" Then Exit Function
On Error GoTo 0
Select Case ExtChoice
Case 0: Extensions = "(xls|xlsx|xlsm|xlsb)" 'xls, xlsx , xlsm, xlsb
Case 1: Extensions = "xls" 'Only xls
Case 2: Extensions = "xlsx" 'Only xlsx
Case 3: Extensions = "xlsm" 'Only xlsm
Case 4: Extensions = "xlsb" 'Only xlsb
Case 5: Extensions = "csv" 'Only csv
Case 6: Extensions = "txt" 'Only txt
Case 7: Extensions = ".*" 'All files with extension, use *.* for everything
Case 8: Extensions = "(xlsx|xlsm|xlsb)" 'xlsx, xlsm , xlsb
Case 9: Extensions = "(csv|txt)" 'csv and txt files
'You can add more filter options if you want,
End Select
Select Case FileFilterOption
Case 0: FileNameFilter = "'.*/[^~][^/]*\\." & Extensions & "$' " 'No Filter
Case 1: FileNameFilter = "'.*/" & FileNameFilterStr & "[^~][^/]*\\." & Extensions & "$' " 'Begins with
Case 2: FileNameFilter = "'.*/[^~][^/]*" & FileNameFilterStr & "\\." & Extensions & "$' " ' Ends With
Case 3: FileNameFilter = "'.*/([^~][^/]*" & FileNameFilterStr & "[^/]*|" & FileNameFilterStr & "[^/]*)\\." & Extensions & "$' " 'Contains
End Select
folderPath = MacScript("tell text 1 thru -2 of " & Chr(34) & folderPath & _
Chr(34) & " to return quoted form of it's POSIX Path")
folderPath = Replace(folderPath, "'\''", "'\\''")
If Val(Application.Version) < 15 Then
ScriptToRun = ScriptToRun & "set foundPaths to paragraphs of (do shell script """ & "find -E " & _
folderPath & " -iregex " & FileNameFilter & "-maxdepth " & _
Level & """)" & Chr(13)
ScriptToRun = ScriptToRun & "repeat with thisPath in foundPaths" & Chr(13)
ScriptToRun = ScriptToRun & "set thisPath's contents to (POSIX file thisPath) as text" & Chr(13)
ScriptToRun = ScriptToRun & "end repeat" & Chr(13)
ScriptToRun = ScriptToRun & "set astid to AppleScript's text item delimiters" & Chr(13)
ScriptToRun = ScriptToRun & "set AppleScript's text item delimiters to return" & Chr(13)
ScriptToRun = ScriptToRun & "set foundPaths to foundPaths as text" & Chr(13)
ScriptToRun = ScriptToRun & "set AppleScript's text item delimiters to astid" & Chr(13)
ScriptToRun = ScriptToRun & "foundPaths"
Else
ScriptToRun = ScriptToRun & "do shell script """ & "find -E " & _
folderPath & " -iregex " & FileNameFilter & "-maxdepth " & _
Level & """ "
End If
On Error Resume Next
dirName = MacScript(ScriptToRun)
On Error GoTo 0
End Function
顺便说一句，@ urdearboy感谢您的建议，这确实有帮助，虽然我遇到.PasteSpecial的问题，但我仍然找到了解决方法。
对于任何想知道的代码，运行它时代码的作用是它基本上会显示一个对话框，要求您选择所需的文件夹，当您这样做时，它会找到扩展名为.xls的文件（您可以更改它）和执行该文件夹中所有.xls文件的更改。
感谢所有评论过这篇文章的人。 ^ _ ^
答案 1 :(得分：1)
注意：这不是一个解决方案，将被删除。只是想对OP提出建议
您应该按如下方式更新您的Excel操作
This Link会向您显示.Select方法的替代方法。
With wks
.Range("W4:X4") = "OFF -PEAK GEM(MW)"
.Range("J33:M33") = "Hz"
.Range("B33:I33") = "DETAILS"
.Range("R34:X34").Insert , CopyOrigin:=xlFormatFromLeftOrAbove
.Range("R35:X35").Copy
.Range("R35:x35").ClearContents
.Range("R34").PasteSpecial
.Range("K68:L123").Delete Shift:=xlToLeft
.Range("K68:L68") = "UNITS ON BAR"
.Range("V178") = "EXPECTED RESERVE"
End With