VBA，循环目录，文件导致错误
我有一个代码循环目录，但是当它到达一个特定的文件，我得到一个运行时错误13.types不匹配。
debugging线：
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
你可以使用像这样的东西来寻找出现错误的表单：
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