Question

我有一个循环遍历目录的代码，但当它到达某个文件时，我得到一个运行时错误13.输入不匹配。

调试行：

measurement = ws.Evaluate("sumproduct((" & ws.Range(ws.Cells(2, i), ws.Cells(lrw, i)).Address & "<>"""")+0)") / (lrw - 1)

我目录中的所有其他文件都可以正常工作，只需这一个。包含3张。有任何想法吗？我可以打开文件。代码实际上在工作簿的中间工作，并在表2中停止。

Sub stackmeup()
'added function to skip corrupt files works! Adding skipped files works.. and do something about 50%.
'changed lrw to long, doesnt skip those files now :)



Dim wb As Workbook, fileNames As Object, errCheck As Boolean 'part of loop


Dim ws As Worksheet
Dim resultSheet As Worksheet
Dim i As Long
Dim lco As Integer
Dim lrw As Long
Dim resultRow As Integer
Dim measurement As Double

'To compile skipped files
Dim wksSkipped As Worksheet
Set wksSkipped = ThisWorkbook.Worksheets("Skipped")


Set resultSheet = Application.ActiveSheet
resultRow = 1

'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual
'get user input for files to search
  Set fileNames = CreateObject("Scripting.Dictionary")
  errCheck = UserInput.FileDialogDictionary(fileNames)
  If errCheck Then Exit Sub


For Each Key In fileNames 'loop through the dictionary
On Error Resume Next
Set wb = Workbooks.Open(fileNames(Key))
If Err.Number <> 0 Then
    Set wb = Nothing    ' or set a boolean error flag
End If
On Error GoTo 0    ' or custom error handler

If wb Is Nothing Then
wksSkipped.Cells(wksSkipped.Cells(wksSkipped.Rows.Count, "A").End(xlUp).Row + 1, 1) = fileNames(Key)
Else
    Debug.Print "Successfully loaded " & fileNames(Key)
    wb.Application.Visible = False 'make it not visible


    For Each ws In wb.Worksheets
        If Not Application.WorksheetFunction.CountA(ws.Cells) = 0 Then
            'define the range to measure
            lco = ws.Cells.Find("*", , xlValues, xlWhole, xlByColumns, xlPrevious, False).Column
            lrw = ws.Columns("A:Y").Find("*", , xlValues, , xlRows, xlPrevious).Row
            If lrw = 1 Then lrw = 2
            For i = 1 To lco
                measurement = ws.Evaluate("sumproduct((" & ws.Range(ws.Cells(2, i), ws.Cells(lrw, i)).Address & "<>"""")+0)") / (lrw - 1)
                resultSheet.Cells(resultRow, 1).Value = wb.Name
                resultSheet.Cells(resultRow, 2).Value = ws.Name
                resultSheet.Cells(resultRow, 3).Value = ws.Cells(1, i).Value
                resultSheet.Cells(resultRow, 4).Style = "Percent"
                resultSheet.Cells(resultRow, 5).Value = measurement
                resultRow = resultRow + 1
            Next
        End If
    Next
    wb.Application.Visible = True '' I added
    wb.Close savechanges:=False 'close the workbook do not save
    Set wb = Nothing 'release the object
    End If
Next 'End of the fileNames loop

Set fileNames = Nothing
'Message Box when tasks are completed
MsgBox "Task Complete!"

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Function Col_Letter(lngCol As Long) As String
    Dim vArr
    vArr = Split(Cells(1, lngCol).Address(True, False), "$")
    Col_Letter = vArr(0)
End Function

Answer 1

您可以使用以下内容查找导致错误的工作表：

Dim measurement As Variant
'...
'...

For i = 1 To lco

    On Error Resume Next
    measurement = ws.Evaluate("sumproduct((" & _
               ws.Range(ws.Cells(2, i), ws.Cells(lrw, i)).Address & _
               "<>"""")+0)") / (lrw - 1)
    On Error Goto 0

    With resultSheet.Rows(resultRow)
        .Cells(1).Value = wb.Name
        .Cells(2).Value = ws.Name
        .Cells(3).Value = ws.Cells(1, i).Value
        .Cells(4).Style = "Percent"
        .Cells(5).Value = IIf(IsError(measurement),"Error!",measurement)
    End With
    resultRow = resultRow + 1
Next

VBA，循环目录，文件导致错误

1 个答案: