如何为VBA从SQL查询数据加速？

助子

本人学习VBA和SQL不久，正在试着利用VBA远程登陆SQL查询数据并导入到EXCEL表格中，下面是我应用的一个例子：
相信很多在工厂上班的人都知道BOM表这个东西，也就是某一个成品的材料列表，我现在的任务是根据输入的机型从我们的SQL数据里面拿到对应的BOM表，因为成品下面会有材料和半成品，半成品下面又会有材料和半成品，如此就需要一层层查询下去，直到找出所有对应的材料列表。
我写的这段程序运行没有问题，但是问题在于其运行的速度比较慢，请高手帮忙查看哪里可以改进从而加快其运行速度？

程序里面访问的数据表有两个:"item"和"jobmatl"，我各拿了一些数据放在附件里面方便大家理解，另外一个附件表格"Result"是当我输入一个机型"1301F-R"时程序跑出来的结果。总共需要五十多秒的时间。
可能对于没有接触过BOM表的人来说不是很好理解其中的逻辑，但是我相信高手只要一看代码便知道运行速度慢的问题在哪里，还望不吝赐教，不胜感激。

Sub TEST()
Application.ScreenUpdating = False
Dim time As Double
time = Timer
Dim iMsg, CH, CA, abc, aa, r, bb As String
Dim g, i, j, h, irow, icol As Integer
Dim arr
Set cn = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
   
cn.Open "Provider=sqloledb.1;Persist Security Info=True;User ID=sa;Password=sa;Initial Catalog=uchidata;Data Source=192.168.8.95"
cn.CommandTimeout = 720
iMsg = InputBox(":")
CH = "select job from item where item ='" + iMsg + "' "
rs.Open CH, cn, 3, 1
aa = rs("job")         '输入一个机型(item)，然后在"item"表中找到对应的"job"
rs.Close

CA = "select item,matl_qty,matl_qty as new,ref_type from jobmatl where job ='" + aa + "' "
rs.Open CA, cn, 3, 1   '通过前面找到的"job"，在"jobmatl"表中找到对应的几列数据(材料列表)
For j = 0 To rs.Fields.Count - 1
Cells(1, j + 3) = rs.Fields(j).Name
Next
r = Range("c65536").End(xlUp).Row
irow = rs.RecordCount
icol = rs.Fields.Count
arr = rs.GetRows
rs.Close
Range(Cells(r + 1, 3), Cells(r + irow, 2 + icol)) = Application.WorksheetFunction.Transpose(arr)
                       '将找到的材料列表放入EXCEL表格中
g = ActiveSheet.UsedRange.Rows.Count
Range("b" & r + 1, "b" & g) = UCase(iMsg)
                       '在B列放入直接对应的机型(item)
For h = 1 To 10000
If Cells(h, 3) = "" Then
Exit For
End If
                       '如果没有数据则推出循环，这里用10000是因为所有机型的材料列表都不会超过10000行。
If Cells(h, 6).Value = "J" And Cells(h, 4) > 0 Then
                       '如果ref_type为"J"则说明对应的item还有下一级的材料列表，需要继续找下去。
abc = Cells(h, 3).Value
bb = Cells(h, 4)
CH = "select job from item where item ='" + abc + "' "
rs.Open CH, cn, 3, 1   '继续以ref_type为"J"对应的item回到"item"表找到对应的"job"号码
aa = rs("job")
rs.Close
CA = "select item,matl_qty,matl_qty *" + bb + " as new,ref_type from jobmatl where job ='" + aa + "' "
rs.Open CA, cn, 3, 1   '以新找到的"job"号码找到新的材料列表
r = Range("c65536").End(xlUp).Row
irow = rs.RecordCount
icol = rs.Fields.Count
arr = rs.GetRows
rs.Close
Range(Cells(r + 1, 3), Cells(r + irow, 2 + icol)) = Application.WorksheetFunction.Transpose(arr)
                       '新的材料列表继续放入EXCEL表格中。
g = ActiveSheet.UsedRange.Rows.Count
Range("b" & r + 1, "b" & g) = abc
End If
Next

g = ActiveSheet.UsedRange.Rows.Count
Range("A2", "A" & g) = UCase(iMsg)
                        '第一列放第一次输入的机型(item)
[A1] = "Model-F"
[B1] = "Model-Sub"
Application.ScreenUpdating = True
MsgBox Timer - time
End Sub

[ 本帖最后由 助子 于 2010-7-31 17:21 编辑 ]

助子

没人回答？看来是将问题描述得太复杂了？

Renco

ADO是逐条去扩展,即用一条条记录使用递归算法方式
但用SQL来做,也是用同样的递归原理,但作用的不是一条条记录,而是一个记录集,即一层层递归,一个BOM下来,最多的一般也不会超过10层,但计算的时间,就象是ADO记算了10次记录一样

[ 本帖最后由 Renco 于 2010-8-2 13:02 编辑 ]

styhs

呵呵，楼主罗列的示例数据好像残缺不全，看不出BOM的层数是多少层；从其他数据上看，估计层数不多。

一般来说，数据储存在SQL中，想获得稳定、较好的性能，当然是在SQL中编制存储过程来返回结果。假如是使用MSSQL2005或以上版本，使用递归公用表达式可以轻松返回产品的所有下级物料，再分步自连接BOM表可返回最终的物料清单。

假如一定需要将数据返回Excel再对BOM进行展开，则注意在循环中，尽量避免重复调用Excel对象（此等操作会严重影响性能）。

panan123_0

我运行代码 拒绝访问 哈哈