我可以指定在循环遍历文件夹中的文件之前使用的列吗?

我可以指定在循环遍历文件夹中的文件之前使用的列吗?

我有大量 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 代码的位置,但我无法弄清楚应该把它放在哪里,除非用户为每个文件指定列。这正是我想要避免的。

这是为了交给我工作中的一名本科实习生,因此需要相当简单。

谢谢你的帮助!

相关内容