使用VBA进行数据匹配和查询，运行速度特别慢

yp19920110 · 发表于 2018-7-4 19:13

本人工作有需求使用Excel来处理大量数据，数据量大小情况如下：

	原始数据表单	数据处理表单
行数	3~5万	100~10000
列数	50~100	15~25

需要进行大量Vlookup操作，所以自己做了一个基于数组+字典的查询函数 Ylookup

'Ylookup查询函数
Public Function Ylookup(LookupValue() As Variant, TableArray() As Variant, ColIndexNum() As Integer, Optional x As Integer) As Variant
Dim u_LookupValue_1, u_ColIndexNum_1, u_TableArray_1, u_TableArray_2 As Long '列数和行数
u_LookupValue_1 = UBound(LookupValue, 1)
u_ColIndexNum_1 = UBound(ColIndexNum, 1)
u_TableArray_1 = UBound(TableArray, 1)
u_TableArray_2 = UBound(TableArray, 2)
'创建字典查询 Dic
Set Dic = CreateObject("Scripting.Dictionary")
ReDim YLookupValue(1 To u_ColIndexNum_1, 1 To u_LookupValue_1)
For j = 1 To u_ColIndexNum_1 Step 1 '获取ColIndexNum(i)的列号
For i = 1 To u_TableArray_1 Step 1 '1 -> Sheets("LTE").UsedRange.Rows.Count

复制代码

运行速度太慢，完整数据运行的耗时需要 90+s
附件内原始数据少了很多，也要10+s
详情请下载附件查看。

求教各位大佬，这种情况下该怎么办？
是不是我哪里写错了，还是应该使用其他方式进行查询。。。

yp19920110 · 发表于 2018-7-4 19:15

emmmmm。。。代码被截断了，只能这样发了

'Ylookup查询函数
Public Function Ylookup(LookupValue() As Variant, TableArray() As Variant, ColIndexNum() As Integer, Optional x As Integer) As Variant
Dim u_LookupValue_1, u_ColIndexNum_1, u_TableArray_1, u_TableArray_2 As Long '列数和行数

u_LookupValue_1 = UBound(LookupValue, 1)
u_ColIndexNum_1 = UBound(ColIndexNum, 1)
u_TableArray_1 = UBound(TableArray, 1)
u_TableArray_2 = UBound(TableArray, 2)

'创建字典查询 Dic
Set Dic = CreateObject("Scripting.Dictionary")
ReDim YLookupValue(1 To u_ColIndexNum_1, 1 To u_LookupValue_1)
For j = 1 To u_ColIndexNum_1 Step 1  '获取ColIndexNum(i)的列号
      For i = 1 To u_TableArray_1 Step 1  '1 -> Sheets("LTE").UsedRange.Rows.Count
         Dic(TableArray(i, 1)) = TableArray(i, ColIndexNum(j))
      Next
      'Dic_arr = Array(Dic.keys, Dic.items)  'DeBUG，方便核查Dic字典项目和数据

      For k = 1 To u_LookupValue_1 Step 1
         YLookupValue(j, k) = Dic(LookupValue(k))
      Next
Next

Ylookup = YLookupValue

End Function

abc123281 · 发表于 2018-7-4 23:59

代码仅供参考

查询abc123.rar (1.62 MB, 下载次数: 13)

yp19920110 · 发表于 2018-7-5 09:17

abc123281 发表于 2018-7-4 23:59
代码仅供参考

用SQL啊，这个我还不太熟悉，不知道怎么构造我需要的 SQL语句。

yp19920110 · 发表于 2018-7-5 16:07

在 abc123281 的提示中，新增了SQL数据库查询函数：SQuery()
运行效率大大提升，只需要 150ms 左右。
不错不错，果然是神器，不过还有个问题需要求教：
strSQL = "Select [" & ColIndexStr(i) & "] From [GSM$] Where ECI=" & LookupValue(j)
原始数据的字段、查询的字段 ColIndexStr(i) 不能包含点符号[.] ，否则会报错，请问有没有什么好的解决方案？

SQL查询报错

核心代码如下：
'SQL数据库查询函数
Public Function SQuery(LookupValue() As Variant, ColIndexStr() As String) As Variant
Dim u_LookupValue_1, u_ColIndexStr_1 As Long '列数和行数
Dim SQueryValue() As Variant

u_LookupValue_1 = UBound(LookupValue, 1)
u_ColIndexStr_1 = UBound(ColIndexStr, 1)
ReDim SQueryValue(1 To u_LookupValue_1, 1 To u_ColIndexStr_1)

Dim Conn, Rst As Object
Dim strConn, strSQL As String

'创建ADO对象。ADO - ActiveX Data Objects：ActiveX 数据对象
Set Conn = CreateObject("ADODB.Connection")
Set Rst = CreateObject("ADODB.Recordset")
PathStr = ThisWorkbook.FullName  '文件路径

'设置连接字符串,根据版本创建连接
Select Case Application.Version * 1
Case Is < 12
      strConn = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=excel 8.0;Data source=" & PathStr
Case Is >= 12
      strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & PathStr & ";Extended Properties=""Excel 12.0;HDR=YES"";"""
End Select

'打开数据库链接
Conn.Open strConn
For i = 1 To u_ColIndexStr_1 Step 1
      For j = 1 To u_LookupValue_1 Step 1
         '构造SQL语句
         strSQL = "Select [" & ColIndexStr(i) & "] From [GSM$] Where ECI=" & LookupValue(j)
         '执行查询，并将结果输出到记录集对象
         Set Rst = Conn.Execute(strSQL)  '字段名包含点符号[.] 的时候，这里会报错。
         '清除Null导致的错误，输出至数组保存
         If IsNull(Rst(0).Value) Then
            MsgBox i & vbNewLine & j
            SQueryValue(j, i) = "Null"
         Else
            SQueryValue(j, i) = Rst(0).Value
         End If
      Next
Next

'关闭数据库连接并释放ADO对象
Rst.Close: Set Rst = Nothing

查询v2.rar (1.63 MB, 下载次数: 7)
Conn.Close: Set Conn = Nothing

SQuery = SQueryValue
End Function

详情请下载附件查看：

		自动登录	找回密码
密码			免费注册

使用VBA进行数据匹配和查询，运行速度特别慢

评分

评分