Excel-VBA将多个选定Excel文件中的数据编译为一个Analyzed文件

时间:2015-05-27 14:39:36

标签: vba excel-vba excel

我编写了一个宏来打开所选文件,搜索发生错误的位置,然后将其放在活动单元格的摘要文件中。它工作得很好但现在我想要而不是逐个选择每个文件我可以一起选择所有需要的文件或者我可以打开一个文件并运行到最后一个文件,因为文件名是串联的,即电机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 

1 个答案:

答案 0 :(得分:2)

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

如上所示,将大部分代码移动到另一个子代码并将文件名传递给新的子代可能会有所帮助。