VBALinkMysql/拉取电阻信息.vba

69 lines
2.5 KiB
Plaintext

Sub 拉取电阻信息()
t = Timer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Sql = "SELECT order_no,resistivity, "
Sql = Sql + "case when resistivity LIKE '>%' then SUBSTRING(resistivity,5,7) "
Sql = Sql + " when resistivity LIKE '%~%' then SUBSTRING_INDEX(resistivity,'~',1) "
Sql = Sql + " when resistivity LIKE '%-%' then SUBSTRING_INDEX(resistivity,'-',1) "
Sql = Sql + " when resistivity LIKE '<%' then SUBSTRING(resistivity,5,7) "
Sql = Sql + " when resistivity LIKE '>%' then SUBSTRING(resistivity,2,7) "
Sql = Sql + " when resistivity LIKE '<%' then SUBSTRING(resistivity,2,7) "
Sql = Sql + " when resistivity = '未分档' OR resistivity IS null then '未分档' end "
Sql = Sql + " from mes_sync.mes_disposable_qc_task "
Sql = Sql + " Union "
Sql = Sql + " SELECT order_no,resistivity, "
Sql = Sql + " case when resistivity LIKE '&gt;%' then SUBSTRING(resistivity,5,7) "
Sql = Sql + " when resistivity LIKE '%~%' then SUBSTRING_INDEX(resistivity,'~',1) "
Sql = Sql + " when resistivity LIKE '%-%' then SUBSTRING_INDEX(resistivity,'-',1) "
Sql = Sql + " when resistivity LIKE '&lt;%' then SUBSTRING(resistivity,5,7) "
Sql = Sql + " when resistivity LIKE '>%' then SUBSTRING(resistivity,2,7) "
Sql = Sql + " when resistivity LIKE '<%' then SUBSTRING(resistivity,2,7) "
Sql = Sql + " when resistivity = '未分档' OR resistivity IS null then '未分档' end "
Sql = Sql + " from mes_sync.mes_recycle_material_storage; "
Call AutoRun '------获取数据库连接
Application.StatusBar = "正在拉取批次信息"
RES.Open Sql, conn '-----执行strSql 获得结果集
Application.StatusBar = "正在复制批次信息到表格"
Sheets("电阻信息").Cells(2, 1).CopyFromRecordset RES
RES.Close '-------关闭结果集 必须要做的
Call closeConn
尾行 = Cells(Rows.Count, "A").End(xlUp).row
Application.StatusBar = "正在判断高低阻信息"
For i = 2 To 尾行
电阻 = Sheets("电阻信息").Cells(i, 3).Value
On Error Resume Next
If 电阻 = "未分档" Then
Sheets("电阻信息").Cells(i, 4).Value = "低阻"
Else
If 电阻 >= 1.9 Then
Sheets("电阻信息").Cells(i, 4).Value = "高阻"
Else: Sheets("电阻信息").Cells(i, 4).Value = "低阻"
End If
End If
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.StatusBar = "拉取完成"
MsgBox ("本次更新共花费:" & Format(Timer - t, "0.00") & "s!")
Application.StatusBar = False
End Sub