Excel-VBA 将多个选定 Excel 文件中的数据编译成一个分析文件答案

【问题标题】：Excel-VBA to compile data from multiple selected Excel files into one Analysed fileExcel-VBA 将多个选定 Excel 文件中的数据编译成一个分析文件
【发布时间】：2015-05-27 14:39:36
【问题描述】：

我编写了一个宏，它可以打开所选文件，搜索发生错误的位置，然后将其放入活动单元格的摘要文件中。它工作得很好，但现在我希望不是一个一个地选择每个文件，我可以一起选择所有需要的文件，或者我可以打开一个文件并运行到最后一个文件，因为文件名是串联的，即电机 21、电机 22 和很快。在这篇文章中有一些帮助，但我不知道我是否可以使用它。

http://www.mrexcel.com/forum/excel-questions/602222-macro-compile-data-multiple-excel-files-into-one-summary-file.html

Sub InputData()

Dim fNameAndPath As Variant
Dim wb As Workbook, temporaryWB As Workbook
Dim oRange As Range, aCell As Range, bCell As Range
Dim ws As Worksheet
Dim SearchString As String, DateCol As String
Dim CumSum As Double, counter As Double, cum As Double
Dim strSheetName As String, CellName As String
Dim lastColumn As Long

Set wb = ThisWorkbook

strSheetName = ActiveSheet.Name
CellName = ActiveCell.Address
cum = Range(CellName).Offset(-1, 2).Value

fNameAndPath = Application.GetOpenFilename(Title:="Select File To Be Opened")
If fNameAndPath = False Then Exit Sub
Set temporaryWB = Workbooks.Open(fNameAndPath)

Set ws = ActiveSheet
Set oRange = ws.Range("C:C")

SearchString = "10000"

Set aCell = oRange.Find(What:=SearchString, LookIn:=xlValues, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
    MatchCase:=False, SearchFormat:=False)


If Not aCell Is Nothing Then ' searching codeID string first time

    aCell.Select
    DateCol = aCell.Offset(0, -2)
    counter = aCell.Offset(0, -1)

    wb.Worksheets(strSheetName).Range(CellName) = DateCol
    wb.Worksheets(strSheetName).Range(CellName).Offset(0, 1) = counter

    CumSum = counter + cum
    wb.Worksheets(strSheetName).Range(CellName).Offset(0, 2) = CumSum
    wb.Worksheets(strSheetName).Range(CellName).Offset(0, 3) = "1000000"
    wb.Worksheets(strSheetName).Range(CellName).Offset(0, 4) = "50"

    lastColumn = ws.UsedRange.Columns.Count

    If InStr(1, ActiveCell.End(xlToRight).Offset(1, 3).Value, "1ms", vbTextCompare) <> 0 Then
        wb.Worksheets(strSheetName).Range(CellName).Offset(0, 6) = ActiveCell.End(xlToRight).Offset(1, 3)
        wb.Worksheets(strSheetName).Range(CellName).Offset(0, 7) = ActiveCell.End(xlToRight).Offset(1, 4)

    Else

        wb.Worksheets(strSheetName).Range(CellName).Offset(0, 6) = Application.InputBox("Enter error", "Dialog box", ActiveCell.End(xlToRight).Offset(1, 3), , , , , 2)
        wb.Worksheets(strSheetName).Range(CellName).Offset(0, 7) = Application.InputBox("Enter error", "Dialog box", ActiveCell.End(xlToRight).Offset(1, 4), , , , , 2)

    End If
Else
    MsgBox SearchString & " not Found"
    Exit Sub
End If

temporaryWB.Close savechanges:=False

End Sub

【问题讨论】：

你尝试过什么来获得你想要的新结果？转储代码并要求我们为您拼凑解决方案可能不会有成效。

标签： vba excel

【解决方案1】：

Application.GetOpenFileName method 有一个可选的 multiselect 参数。

使用可能是 False 或文件名和路径数组（即使该数组是一个文件名/路径的数组）的返回值有点棘手。下面是一些可以帮助您入门的框架。

Sub collect_fns()
    Dim f As Long, fNameAndPath As Variant

    fNameAndPath = Application.GetOpenFilename("Excel files (*.xl*), *.xl*", _
                        Title:="Select File(s) To Be Opened", MultiSelect:=True)

    If IsArray(fNameAndPath) Then
        For f = LBound(fNameAndPath) To UBound(fNameAndPath)
            ' do something with each file as fNameAndPath(f)
            process_each_fn CStr(fNameAndPath(f))
        Next f
    Else
        'no files selected
    End If

End Sub

Sub process_each_fn(fn As String)

    Debug.Print fn

End Sub

如上所示，将大部分代码移动到另一个子程序并通过循环将文件名传递给新子程序可能会有所帮助。

【讨论】：