我刚刚花了很多时间在几十个 excel 文件（都包含相同格式的数据）中创建相同的图表，并且相信必须有一种更有效的方法来完成我刚刚完成的工作。
为简化起见，请考虑 50 个具有相同格式数据的 Excel 文档。是否存在自动的方法：
- 创建一个简单的折线图
- 添加轴标签、图表标签、删除水平网格线
- 包括趋势线/R^2 值
- 将新工作簿保存到某个位置，并在文件名后附加“_graphed”
这是可以使用 Excel VBA 的吗？
问问题
7005 次
2 回答
1
对于这类问题，我会首先将您手动执行的步骤的宏记录到个人宏工作簿中。然后，您可以查看 Excel 生成的代码，您可能会发现无需进行太多更改即可将其用作通用过程。
测试后，如果您想进一步实现自动化，您可以编写一个小程序来遍历目录中的所有 Excel 文件，并在每个文件打开时调用您的图表程序。如果有帮助，我可以挖掘出我编写的类似代码。
更新 这里是一个线程，我提供了一些代码来遍历包含某些给定文本的所有文件（在本例中为“.pdf”，但也可以很容易地使用“.xls”来涵盖 xlsx、xlsm 等）。
此示例还将其找到的文件列表打印到工作表中。这是测试结果的良好开端，但是一旦没问题，您就需要替换该行：
Range(c).Offset(j, 0).Value = vFileList(i)
使用一些代码打开该工作簿并调用您的代码来生成图表。如果您遇到困难，请告诉我。
进一步更新
我已经查看了上面提到的代码并进行了一些改进，包括一个附加参数，用于指定要针对每个打开的工作簿（满足指定条件）运行的宏的名称。您在调用中使用的宏必须存在于您从中调用所有其他工作簿的工作簿中（例如，如果图表宏在您的个人工作簿中，那么下面的代码也应该放在您的个人宏工作簿中）：
Option Explicit
Sub FileLoop(pDirPath As String, _
Optional pPrintToSheet = False, _
Optional pStartCellAddr = "$A$1", _
Optional pCheckCondition = False, _
Optional pFileNameContains = "xxx", _
Optional pProcToRunOnWb)
On Error GoTo PrintFileList_err
' Local constants / variables
Const cProcName = "FileLoop"
Dim vFileList() As String ' array for file names
Dim i As Integer ' iterator for file name array
Dim j As Integer ' match counter
Dim c As String
' variables for optional param pProcToRunOnWb
Dim vFullPath As String
Dim vTmpPath As String
Dim wb As Workbook
vFullPath = Application.ThisWorkbook.FullName
vFileList = GetFileList(pDirPath)
c = pStartCellAddr
j = 0
For i = LBound(vFileList) To UBound(vFileList)
' if condition is met (i.e. filename cotains text or condition is not required...
If pCheckCondition And InStr(1, vFileList(i), pFileNameContains, vbTextCompare) > 0 _
Or Not pCheckCondition Then
' print name to sheet if required...
If pPrintToSheet Then
Range(c).Offset(j, 0).Value = vFileList(i)
j = j + 1 ' increment row offset
End If
' open wb to run macro if required...
If pProcToRunOnWb <> "" Then
Application.DisplayAlerts = False ' set alerts off so that macro can run in other wb
vTmpPath = pDirPath & "\" & vFileList(i)
Set wb = Workbooks.Open(Filename:=vTmpPath)
Workbooks(wb.Name).Activate
Application.Run "'" & vFullPath & "'!" & pProcToRunOnWb
wb.Close (True) ' save and close workbook
Application.DisplayAlerts = True ' set alerts back on
End If
End If
Debug.Print vFileList(i)
Next i
' clean up
Set wb = Nothing
PrintFileList_exit:
Exit Sub
PrintFileList_err:
Debug.Print "Error in ", cProcName, vbCrLf, "Err no: ", Err.Number, _
vbCrLf, "Err Description: ", Err.Description
Resume Next
End Sub
Function GetFileList(pDirPath As String) As Variant
On Error GoTo GetFileList_err
' Local constants / variables
Const cProcName = "GetFileList"
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim c As Double ' upper bound for file name array
Dim i As Double ' iterator for file name array
Dim vFileList() As String ' array for file names
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(pDirPath)
c = objFolder.Files.Count
i = 0
ReDim vFileList(1 To c) ' set bounds on file array now we know count
'Loop through the Files collection
For Each objFile In objFolder.Files
'Debug.Print objFile.Name
i = i + 1
vFileList(i) = objFile.Name
Next
'Clean up!
Set objFolder = Nothing
Set objFile = Nothing
Set objFSO = Nothing
GetFileList = vFileList
GetFileList_exit:
Exit Function
GetFileList_err:
Debug.Print "Error in ", cProcName, vbCrLf, "Err no: ", Err.Number, _
vbCrLf, "Err Description: ", Err.Description
Resume Next
End Function
您可以从另一个宏或从即时窗口 (ctrl+G) 调用它，并使用所需的参数，例如获取包含“.xls”的所有文件，并运行名为“your_macro_name_here”的宏，代码将是：
call FileLoop("C:\Users\Prosserc\Dropbox\Docs\Stack_Overflow\Test", False, "", True, ".xls", "your_macro_name_here")
显然，将第一个参数中的路径更改为指向包含要对其运行宏的文件的目录。
于 2013-08-08T23:18:55.520 回答