Excel VBA - 用于工作的代码,现在找不到问题

时间:2011-10-11 16:10:04

标签: excel vba

我正在使用这段代码,之前它运行得很好,但现在由于某种原因我收到的错误只是说“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个文件。任何帮助将不胜感激,谢谢!

1 个答案:

答案 0 :(得分:0)

错误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并循环访问代码并观察“本地”窗口)并告诉我如果您有任何问题,我们会从那里缩小它。

编辑:让我们一路回来,从另一个角度来解决这个问题。你需要做的是去工具 - &gt;参考文献 - &gt;并向下滚动到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通常总是意味着某些地方发生了变化,现在它无法找到它。而不是去寻找它,通常更容易编码保护。