求救，不打开工作簿，也能调取其他工作簿的所需要的数据到固定表格

源盈实业

我试过用函数，可是函数VLOOKUP在未打开其他工作簿时，无法调取其他的数据，现请教各位专家能否帮小妹解决这一困难，谢谢了。用宏也可以。

TomingTang

用vlookup在未打开工作簿的情况下是无法操作的，必须打开工作簿。另外，你“汇总”工作簿汇总文件夹”IE库“下的工作簿？ 每个工作簿的工作表“开料”的d3：E9区域。这个可以用vba的with getobject进行处理，模拟一个数据，看看。

源盈实业

TomingTang 发表于 2014-11-18 11:04
用vlookup在未打开工作簿的情况下是无法操作的，必须打开工作簿。另外，你“汇总”工作簿汇总文件夹”IE库“ ...

不知道怎么弄，你教我弄弄。谢谢了！

TomingTang

你都没有回答我在楼上给你的提问，貌似很没有诚意哦，小妹。另外，你的数据源的工作表中某些单元格有错误公式，错误公式在vba数组中是无法容纳的，现在我对其进行了特别处理：错误的公式一律标为0.请看汇总结果，看看是否符合要求。另外，这里有一个也是类似的，请参考：http://club.excelhome.net/thread-1166507-1-1.html

1. Sub L()
   
2.     Dim Mypath$, Myname$, str$, sht As Worksheet, i%, Arr(1 To 10000, 1 To 15), drow%, drow1%, Brr, k%, j%, d, mmax%
   
3.     mmax = 1: i = 1
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     On Error Resume Next
   
6.     sht = ThisWorkbook.Worksheets("sheet1")
   
7.     Mypath = ThisWorkbook.Path & "\IE库"
   
8.     Myname = Dir(Mypath & "*.xls")
   
9.     Application.ScreenUpdating = False
   
10. 
    
11.     Do While Myname <> ""
    
12.         If Myname <> ThisWorkbook.Name Then
    
13.            ' MsgBox Myname
    
14.             With GetObject(Mypath & Myname)
    
15.                 With .Worksheets("开料")
    
16.                     Brr = .Range("e3:e9")
    
17.                     Arr(i, 1) = Left(Myname, Len(Myname) - 4)
    
18.                     Arr(i, 2) = IIf(IsError(.Cells(3, 5)), 0, .Cells(3, 5))
    
19.                     Arr(i, 3) = IIf(IsError(.Cells(4, 5)), 0, .Cells(4, 5))
    
20.                     Arr(i, 4) = IIf(IsError(.Cells(5, 5)), 0, .Cells(5, 5))
    
21.                     Arr(i, 5) = IIf(IsError(.Cells(6, 5)), 0, .Cells(6, 5))
    
22.                     Arr(i, 6) = IIf(IsError(.Cells(7, 5)), 0, .Cells(7, 5))
    
23.                      Arr(i, 7) = IIf(IsError(.Cells(8, 5)), 0, .Cells(8, 5))
    
24.                       Arr(i, 8) = IIf(IsError(.Cells(9, 5)), 0, .Cells(9, 5))
    
25.                     Arr(i, 9) = Arr(i, 2) + Arr(i, 3) + Arr(i, 4) + Arr(i, 5) + Arr(i, 6) + Arr(i, 7) + Arr(i, 8)
    
26.                     i = i + 1
    
27.                     mmax = i
    
28.                 End With
    
29.                 .Close False
    
30.             End With
    
31.         End If
    
32.         Myname = Dir
    
33.     Loop
    
34.     With ThisWorkbook.Worksheets("sheet1")
    
35.         .Range("a3:i65536").ClearContents
    
36.         .Cells(3, 1).Resize(mmax, 9) = Arr
    
37.     End With
    
38.     Application.ScreenUpdating = True
    
39. End Sub
    

复制代码

源盈实业

哇，太神奇了，可以了。谢谢哥哥！以后工作轻松一大半！高手，向你致敬！