Question

我编写了一个宏来打开所选文件，搜索发生错误的位置，然后将其放在活动单元格的摘要文件中。

它工作得很好，但现在我已经改变它，以便我可以一起选择多个文件，而不是逐个选择每个文件。

它在行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

fNameAndPath 变量是一个数组，您使用 f 对其进行索引。您需要将索引添加到数组中，以便Workbooks.Open知道要从数组中取出哪个部分。

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

将多个选定Excel文件中的数据编译为一个摘要文件

1 个答案: