当前位置：首页 → 问答吧 → 重发求助在大量工作簿中查找相同代码返回需要的值

重发求助在大量工作簿中查找相同代码返回需要的值

时间：2011-08-10

来源：互联网

先上附件
文件夹数据库中一共有30多个工作簿
大约20多万组数据，写公式太慢啦
求高手帮帮忙写个VBA
最好能在后面说明一下代码的意思

附件

新建文件夹 (2).rar(188.07 KB)

2011-8-10 09:35, 下载次数: 18

作者: weiqqpeng 发布时间: 2011-08-10

高手们来看看啊谢谢啊

作者: weiqqpeng 发布时间: 2011-08-10

I recommend you to use WBS编码 as name of 数据库中工作簿

作者: KCFONG 发布时间: 2011-08-10

哥们能说清楚点吗
这个这个东西到底应该怎么搞啊

作者: weiqqpeng 发布时间: 2011-08-10

用http://club.excelhome.net/thread-723057-1-1.html
方法把每个表格汇总到一张SHEET里，再用Vlookup函数
建议楼主用07版，每张SHEET能装1048576行数据（03版只能装65536行）

作者: dudebad 发布时间: 2011-08-10

高手们能不能做个直接调取的VBA啊用公式在几十万行数据中查找太浪费资源吧

作者: weiqqpeng 发布时间: 2011-08-10

数据庞大，打开EXCEL都要等一段时间，何况运行公式。如果楼主要节省资源，你应该用数据库软件处理。

作者: dudebad 发布时间: 2011-08-10

复制内容到剪贴板

代码:

此段代码放在模块1里面：
Public k, t
Sub yy()
Dim Arr, myPath$, myName$, sh As Worksheet, x$
Dim wb As Workbook, i&, d, funm$
Set d = CreateObject("Scripting.Dictionary")
funm = ThisWorkbook.Name
myPath = ThisWorkbook.Path & "\数据库\"
myName = Dir(myPath & "*.xls")
Do While myName <> "" And myName <> funm
      With GetObject(myPath & myName)
         Set wb = Workbooks(myName)
         Set sh = wb.Sheets("Sheet1")
         Arr = sh.[a1].CurrentRegion
         For i = 2 To UBound(Arr)
            x = Arr(i, 1)
            d(x) = Arr(i, 3) & "|" & Arr(i, 4) & "|" & Arr(i, 5)
         Next
         .Close False
      End With
      myName = Dir
Loop
k = d.keys
t = d.items
Set d = Nothing
End Sub
此段代码放在Thisworkbook里面：
Private Sub Workbook_Open()
Call yy
End Sub
此段代码放在工作表1里面
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Column <> 6 Or Target.Row < 2 Then Exit Sub
Dim i&
For i = 0 To UBound(k)
If Target = Val(k(i)) Then
      aa = Split(t(i), "|")
      Target.Offset(0, 1) = aa(0)
      Target.Offset(0, 4) = aa(1)
      Target.Offset(0, 6) = aa(2)
End If
Next
End Sub

作者: 蓝桥玄霜发布时间: 2011-08-10

请见附件。