Excel + VBA + SQL 查询数据库，如何提速

biaobro@sina · 发表于 2021-10-25 00:10

现在有通过信息搜集平台得到的Excel数据，需要用Excel中的数据，在数据库中查询对应信息。功能已经实现，但是速度很慢，1条1秒，1400条数据需要20多分钟，请教是否有合适的方法可以并行查询，或者提速

f8b1987 · 发表于 2021-10-25 08:20

1条1秒夸张了，说明你用的方法不对

笑着...两年过去 · 发表于 2021-10-25 10:09

可以把要查询的数据，先批量写到sql数据库，然后再sql里查，将结果再批量返回excel，这样就能秒开了

小書生 · 发表于 2021-10-25 10:38

不要一条一条处理，那样的话，不如数组字典来得快

biaobro@sina · 发表于 2021-11-7 00:37

本帖最后由 biaobro@sina 于 2021-11-7 09:05 编辑

笑着...两年过去发表于 2021-10-25 10:09
可以把要查询的数据，先批量写到sql数据库，然后再sql里查，将结果再批量返回excel，这样就能秒开了

大侠您好您说的这个思路的具体做法可否再具体指点一下
我的数据如附件，A列单元格中保存的是订单号，有1个单元格保存1个订单的，还有1个单元格保存几个订单的，需要用这些订单号到数据库中查询对应订单数量（有效性），下单渠道（group_concat)，订单金额(sum).

我现在做法是用For循环，读单元格，然后查询，代码如下。这样的话，1个单元格的查询加上回写就是1秒左右。 1400多行要20分钟。。。。

Sub link_Order()
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
Dim strSql As String
'配置连接串
conn.ConnectionString = "Driver={MySQL ODBC 8.0 Unicode Driver};Server=localhost;DB=ticket;UID=root;PWD=2020;OPTION=3;"
'conn.Open
'从数据库表中取数据
For i = 2 To Range("A1").CurrentRegion.Rows.Count Step 1
conn.Open
'sql 多行写的时候要特别注意分割以及空格
strSql = "SELECT count(*)," & _
"GROUP_CONCAT( DISTINCT t.order_channel )," & _
"SUM( t.tmoneysum )," & _
"SUM( t.texpressfee ) " & _
"FROM" & _
"(SELECT order_id," & _
"order_channel," & _
"sum( ticket_count ) AS tticektsum," & _
"sum( ticket_price )," & _
"sum( money_should_receive ) AS tmoneysum," & _
"sum(express_fee) As texpressfee " & _
"FROM " & _
"order_detail_f " & _
"WHERE " & _
"order_id IN (" & Cells(i, 1).Value & ") Group BY order_id ) t"
Debug.Print (i)
rs.Open strSql, conn
'将数据输出到工作表
Cells(i, 2).CopyFromRecordset rs
'关闭连接
rs.Close
conn.Close
Next
Set rs = Nothing
Set conn = Nothing
End Sub

复制代码

T100 · 发表于 2021-11-7 15:06

"order_id IN  (" & Cells(i, 1).Value & ") Group BY order_id ) t"
先把所有单号放到一起再查询
For i = 2 To Range("A1").CurrentRegion.Rows.Count Step 1
   sql = sql & WorksheetFunction.Substitute(Cells(i, 1).Value, ",", "','") & "','"
Next
sql = "'" & Left(sql, Len(sql) - 2)
然后再执行查询
"order_id IN  (" & sql & ") Group BY order_id ) t"

biaobro@sina · 发表于 2021-11-7 16:26

本帖最后由 biaobro@sina 于 2021-11-7 16:41 编辑

T100 发表于 2021-11-7 15:06
"order_id IN (" & Cells(i, 1).Value & ") Group BY order_id ) t"
先把所有单号放到一起再查询
For i ...

谢谢指点。把所有单号放在一起查的话，像A7 单元格这种，得到的是3条记录。还得再做合并处理：对数量和金额求和，对渠道进行去重拼接。不知道有没有直接一步到位的办法。
而且在一些极端情况下，比如用户填写的3个单号，其中1个是错的，那数据库返回是2条。如果直接按照3条记录拼接，就会导致A7后面的数据错乱所以，从单元格的角度看，还是整体查询，整体返回

biaobro@sina · 发表于 2021-11-9 23:30

哈哈啊哈哈哈哈哈哈搞出来了 7300行 20秒虽然20s假死但已经非常能接受了

Option Explicit
Sub orderQuerybyCell()
Dim t As Variant
t = Timer
Const unitOrderLen = 18
' 字符串数组，用于存放单元格内容拆分后的结果
Dim cellStrArray() As String
' 外层循环计数器
Dim outerCounter As Integer
outerCounter = 0
' 内层循环计数器
Dim innerCounter As Integer
innerCounter = 0
' 订单字符串
Dim orderStr As String
orderStr = ""
Dim finalOrderStr As String
finalOrderStr = ""
Dim cell As Range
Dim element As Variant
' 清除格式
Selection.ClearFormats
' 设置格式，分列成文本，避免科学计数法导致的问题
Selection.TextToColumns Destination:=Selection, DataType:=xlDelimited, FieldInfo:=Array(1, 2)
' 设置格式，单元格内容显示不超出单元格范围不灵
'Selection.Resize(1, 8).EntireColumn.HorizontalAlignment = xlFill
' 1个备注行存放问题订单
' 1个备注行存放正常订单号
' 5个标题行存放字段对应的数据
Selection.Offset(0, 1).Resize(1, 7).EntireColumn.Insert
' 如果选中的是整列，那跳过第1行标题行
If Selection.Address = Selection.EntireColumn.Address Then
'MsgBox "Yes,you select whole column"
Selection.Resize(ActiveCell.CurrentRegion.Rows.Count - 1, 1).Offset(1, 0).Select
Debug.Print Selection.Address
End If
' 第1大步，拼接查询条件。遍历所选区域单元格，拼接全部订单号，得到用于SQL查询的订单字符串
For Each cell In Selection
' 长度大于18，即不止1个单号
If Len(cell) > unitOrderLen Then
cellStrArray = Split(cell.Value, ",")
For Each element In cellStrArray
orderStr = orderStr + cellStrArray(innerCounter) + ","
innerCounter = innerCounter + 1
Next
innerCounter = 0
orderStr = Left(orderStr, Len(orderStr) - 1)
'只有1个单号
Else
orderStr = orderStr + cell.Value
End If
' 将单元格内的字符串加到整体字符串上
finalOrderStr = finalOrderStr & orderStr & ","
orderStr = ""
Next
' 去掉末尾的逗号
finalOrderStr = Left(finalOrderStr, Len(finalOrderStr) - 1)
'Debug.Print finalOrderStr
Debug.Print Timer - t
' 第2大步，查询数据
Dim conn As ADODB.Connection
Set conn = New ADODB.Connection
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
'配置数据库连接串
conn.ConnectionString = "Driver={MySQL ODBC 8.0 Unicode Driver};Server=localhost;DB=ticket;UID=root;PWD=2020;OPTION=3;"
conn.Open
'定义 SQL语句
Dim strSql As String
strSql = "SELECT order_id," & _
"order_channel," & _
"sum( ticket_count ) AS tticketsum," & _
"sum( money_should_receive ) AS tmoneysum," & _
"sum( express_fee ) As texpressfee " & _
"FROM " & _
"order_detail_f " & _
"WHERE " & _
"order_id IN (" & finalOrderStr & ") Group BY order_id "
'Debug.Print strSql
'从数据库表中取数据
rs.Open strSql, conn, adOpenDynamic, adLockReadOnly
'将数据输出到工作表
'Range("B2").CopyFromRecordset rs
Debug.Print Timer - t
' 第3大步，处理数据
' 存放正常订单号
Dim groupNormalOrder As String
groupNormalOrder = ""
'存放问题订单号（可能是订单单号错误，也可能是订单已关闭）
Dim groupAbnormalOrder As String
groupAbnormalOrder = ""
' 订单下单渠道，需要去重
Dim groupOrderChannel As String
groupOrderChannel = ""
' 订单总数量
Dim groupOrderCount As Integer
groupOrderCount = 0
' 票总数量
Dim groupTicketCount As Integer
groupTicketCount = 0
' 订单总金额
Dim groupOrderMoney As Long
groupOrderMoney = 0
' 快递费总金额
Dim groupExpressMoney As Long
groupExpressMoney = 0
outerCounter = 0
innerCounter = 0
' 遍历区域中的单元格
For Each cell In Selection
rs.MoveFirst
' 单元格长度是否大于18
If Len(cell) > unitOrderLen Then
innerCounter = 0
' 拆分单元格成数组
cellStrArray = Split(cell.Value, ",")
' 遍历数组中的元素，即单元格内的每条订单号
For Each element In cellStrArray
rs.Find "order_id = '" & cellStrArray(innerCounter) & "'"
If rs.EOF Then
'MsgBox ("订单不存在")
groupAbnormalOrder = groupAbnormalOrder + cellStrArray(innerCounter) + ","
Else
'对下单渠道信息进行拼接，已存在的什么也不做，不存在的拼接
If InStr(groupOrderChannel, rs.Fields("order_channel")) > 0 Then
Else
groupOrderChannel = groupOrderChannel + rs.Fields("order_channel") + ","
End If
'只对正常订单进行信息汇总
groupNormalOrder = groupNormalOrder + cellStrArray(innerCounter) + ","
groupOrderCount = groupOrderCount + 1
groupTicketCount = groupTicketCount + rs.Fields("tticketsum")
groupOrderMoney = groupOrderMoney + rs.Fields("tmoneysum")
groupExpressMoney = groupExpressMoney + rs.Fields("texpressfee")
innerCounter = innerCounter + 1
End If
' 移动搜索游标到开头，否则是从上一个搜索结果的位置开始Find,不一定能查到结果
rs.MoveFirst
Next
If groupAbnormalOrder <> "" Then
cell.Offset(0, 1) = Left(groupAbnormalOrder, Len(groupAbnormalOrder) - 1) + " 无对应订单信息"
Else
groupAbnormalOrder = " "
End If
cell.Offset(0, 2) = Left(groupNormalOrder, Len(groupNormalOrder) - 1)
cell.Offset(0, 3) = groupOrderCount
cell.Offset(0, 4) = groupTicketCount
cell.Offset(0, 5) = Left(groupOrderChannel, Len(groupOrderChannel) - 1)
cell.Offset(0, 6) = groupOrderMoney
cell.Offset(0, 7) = groupExpressMoney
' 每次单元格处理完成，要清空变量。便于下个单元格使用
groupNormalOrder = ""
groupAbnormalOrder = ""
groupOrderCount = 0
groupTicketCount = 0
groupOrderChannel = ""
groupOrderMoney = 0
groupExpressMoney = 0
' 只有1条订单的情况
Else
rs.Find "order_id = '" & cell.Value & "'"
If rs.EOF Then
'MsgBox ("订单不存在")
'找不到匹配对象时，应该什么都不做
cell.Offset(0, 1) = cell.Value + " 无对应订单信息"
cell.Offset(0, 2) = " "
cell.Offset(0, 3) = " "
cell.Offset(0, 4) = " "
cell.Offset(0, 5) = " "
cell.Offset(0, 6) = " "
cell.Offset(0, 7) = " "
Else
cell.Offset(0, 1) = " "
cell.Offset(0, 2) = cell.Value
cell.Offset(0, 3) = 1
cell.Offset(0, 4) = rs.Fields("tticketsum")
cell.Offset(0, 5) = rs.Fields("order_channel")
cell.Offset(0, 6) = rs.Fields("tmoneysum")
cell.Offset(0, 7) = rs.Fields("texpressfee")
End If
End If
Next
'关闭数据库连接
rs.Close
conn.Close
'清理变量
Set rs = Nothing
Set conn = Nothing
MsgBox "用时 " & (Timer - t) & "秒", vbInformation
End Sub

复制代码

zpy2 · 发表于 2021-11-10 13:59

biaobro@sina 发表于 2021-11-9 23:30
哈哈啊哈哈哈哈哈哈搞出来了 7300行 20秒虽然20s假死但已经非常能接受了

1，用存储过程
2，最好不要嵌套子查询
3，group字段需要索引

jiangxiaoyun · 发表于 2021-11-10 14:04

既然用sql了，就不要用for循环了。不见得sql语句有多复杂要嵌套在for循环中。。。。

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

[求助] Excel + VBA + SQL 查询数据库，如何提速

评分

最新热点 /1