将来自多个选定Excel文件的数据编译成一个摘要文件

我已经写了一个macros来打开选定的文件，search发生错误的位置，然后将其放在活动单元格的摘要文件中。

这是完美的工作，但现在我已经改变了，所以我可以一起select多个文件，而不是逐一select每个文件。

它在行中显示错误Set wb = Workbooks.Open(fNameAndPath)作为Typemismatch

有人能帮助我吗？

 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 Dim f As Long Set wb = ThisWorkbook ' Set ws = ActiveSheet 'Set Rng1 = Application.InputBox("select cell where you want to insert new data", Type:=8) 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) strSheetName = ActiveSheet.Name CellName = ActiveCell.Address cum = Range(CellName).Offset(-1, 2).Value Set wb = 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 ' Set bCell = aCell ' defining Algorithm to supress repetition 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.Offset(1, lastColumn - 2).Value, "1ms", vbTextCompare) <> 0 Then 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) ' aCell.Offset(-1, 0).Select 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) ' wb.Worksheets(strSheetName).Range(CellName).Offset(0, 6) = ActiveCell.Offset(0, lastColumn - 2) End If Else MsgBox SearchString & " not Found" Exit Sub End If temporaryWB.Close savechanges:=False ActiveCell.Offset(1, 0).Select Next f Else 'no files selected End If End Sub 

Answer 1

fNameAndPathvariables是一个数组，你用f来索引它。 您需要将索引添加到数组中，以便Workbooks.Open知道从数组中提取哪个部分。

  Set wb = Workbooks.Open(fNameAndPath(f))