Excel VBA - 代码曾经可以工作，现在找不到问题

Question

我正在使用这段代码，之前工作得很好，但现在由于某种原因，我收到一个错误，只显示“400”，而且我认为我没有更改任何内容。

Sub getdata()

Dim xcell As Range
Dim ycell As Range
Dim sheetname As String
Dim wblist() As String
Dim i As Integer
Dim wbname As String
Dim j As Integer

i = 0
j = 0

FolderName = "C:\Documents and Settings\shahzad.khan\Desktop\CRs\LOG"
wbname = Dir(FolderName & "\" & "*.xls")

Application.ScreenUpdating = False

Do While wbname <> ""

i = i + 1
ReDim Preserve wblist(1 To i)
wblist(i) = wbname
wbname = Dir


Set ycell = Range(Cells(i + 3, 2), Cells(i + 2, 28))
Set xcell = Range(Cells(2, 3), Cells(2, 28))
sheetname = "loging form"

ycell.Formula = "=" & "'" & FolderName & "\[" & wblist(i) & "]" _
& sheetname & "'!" & xcell.Address

Loop

Do While j < 100
Cells(j + 3, 1).Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[6],4)"

Cells(3 + j, 1) = Val(Cells(3 + j, 1))
Cells(3 + j, 2).Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-1],'[CR Status.xlsx]Sheet1'!R3C1:R189C3,3,FALSE)"

If Cells(3 + j, 1).Value = 0 Then
Cells(3 + j, 1).Value = ""
Cells(3 + j, 2).Value = ""
End If

j = j + 1

Loop

Application.CutCopyMode = False
Application.ScreenUpdating = True

Cells(1, 1).Select

End Sub

我知道代码现在效率不是很高，但它确实有效。它似乎粘贴了我想要的大部分信息，但由于某种原因，它没有捕获我试图从中提取的 Excel 文件中的第一列和最后一列，并且第二个循环甚至没有开始。另外，它不再访问文件夹中的每个文件，它似乎在目录末尾之前停止了大约 4 个文件。任何帮助将不胜感激，谢谢！

Answer 1

错误 400 对应于应用程序定义或对象定义的错误。这意味着它通常不喜欢或理解您对某些内容的引用。

浏览您的代码，唯一弹出的地方是您的代码，

   Do While j < 100
   Cells(j + 3, 1).Select
   ActiveCell.FormulaR1C1 = "=LEFT(RC[6],4)"

除非我错过了它，否则我看不到您在哪里引用了您希望它循环遍历的工作表。

顺便说一句，你真的不应该“选择”一个单元格。它缓慢且低效。与工作表相同。您可以做类似的事情..

   Do While j < 100
   'First way
   Sheet1.Cells(J+3,1).FormulaR1C1 = "=Left(RC[6],4)"
   'Second way
   Worksheets("Sheet1").Cells(J+3,1).FormulaR1C1 = "=Left(RC[6],4)"

尝试确保所有引用都已显式设置（使用 f8 并循环遍历代码并观察“Locals”窗口），如果您有任何问题，请告诉我，我们会缩小范围从那里下来。

编辑：让我们从另一个角度来解决这个问题。您需要做的是转到“工具”->“参考文献->向下滚动到 Microsoft Scripting Runtime，单击它并单击“确定”。然后使用以下代码。

Sub Main()
Dim FSO As FileSystemObject
Dim File As File
Dim Folder As Folder
Dim Files As Files
Dim WkBook As Workbook
Dim FileInfo As Variant

Set FSO = New FileSystemObject
Set Folder = FSO.GetFolder("C:\Documents and Settings\shahzad.khan\Desktop\CRs\LOG")
Set Files = Folder.Files

For Each File In Files

    If Right(File.Name, 3) = "xls" Then

    Set WkBook = Workbooks.Open(File)
    FileInfo = WkBook.Worksheets("Sheet1").Range("A2:J400").Value

    'Do Work With Array Here

    WkBook.Close
    End If

Next

Set Files = Nothing
Set Folder = Nothing
Set FSO = Nothing


End Sub

现在，无论您添加或删除多少个文件，该代码都将起作用。当您完成对数组的处理并希望将信息放入另一个 Excel 工作表中时，您只需翻转代码即可。就像...

MyWorkbook.Worksheet("Sheet1").Range("A2:J400") = FileInfo

我知道这并不能回答最初的问题，但错误 400 通常总是意味着某些地方发生了变化，但现在找不到它。与其去寻找它，通常更容易编写一些保护代码。