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

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