我有大量 Excel 文件,需要将其中的数据从一个测量单位转换为另一个测量单位。我有代码来执行转换,我有代码来循环遍历文件夹中的文件,我有代码让用户选择数据所在的列。最后这一点很重要,因为数据来自多个来源,我真的不希望他们必须为每个来源使用不同的宏。
所以我希望能够做的是 1)指定数据所在的列 2)循环遍历给定文件夹中的所有文件(所有文件都应该来自同一来源,因此数据将位于同一列)并运行我需要的转换(我有代码)。
目前,我在 VBA 中遇到了这样的麻烦:
' Change solar data from W/m2 to MJ/m2 and get daily sums
' Set up for the loop
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
' Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
' Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "Select A Target Folder With Your Text Files"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With
'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings
'Target File Extension (must include wildcard "*")
myExtension = "*.xls*"
'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)
' Attempt to have user select column for use
Dim ReturnValue
Set ReturnValue = Application.InputBox("Type the column your solar data is in, e.g. A:A", "Data Select", Type:=8)
'Loop through each Excel file in folder
Do While myFile <> ""
' Open the workbook
Workbooks.Open FileName:=(myPath & myFile)
'Set variable equal to opened workbook
Set wb = ActiveWorkbook
'Ensure Workbook has opened before moving on to next line of code
DoEvents
'Convert W/m2 to MJ/m2
ReturnValue.Offset(, 1).Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Dim col As Long
col = ReturnValue.Column + 1
Cells(1, col).FormulaR1C1 = "MJ/m2"
Dim LastRow As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Dim rng As Range
Set rng = Range(Cells(2, col), Cells(LastRow, col))
rng.FormulaR1C1 = "=IF(RC[-1]=-99.9, -99.9, (RC[-1]*0.086344))" '<-- this formula needs to be divided by 24 if you're starting with a daily sum of hourly averages
'Sum every 24 hours
ReturnValue.Offset(, 2).Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Dim col2 As Long
col2 = ReturnValue.Column + 2
Cells(1, col2).FormulaR1C1 = "MJ/m2/d"
Dim rng2 As Range
Set rng2 = Range(Cells(25, col2), Cells(LastRow, col2))
rng2 = "=IF(MOD(ROW(R[-1]C),24)=0, SUM(R[-23]C[-1]:R[-1]C[-1]), """")"
'Save and Close Workbook
wb.Close SaveChanges:=True
'Ensure Workbook has closed before moving on to next line of code
DoEvents
'Get next file name
myFile = Dir
Loop
我猜想错误出在我放置 InputBox 代码的位置,但我无法弄清楚应该把它放在哪里,除非用户为每个文件指定列。这正是我想要避免的。
这是为了交给我工作中的一名本科实习生,因此需要相当简单。
谢谢你的帮助!