2.批量查询(CUX客户化编码-事件代码)
Sub cuxkehuhuachaxun1()
t = Timer
Sheets("CUX客户化编码").Range("b6:m10000").ClearContents
Dim ztshu1 As Long '查询数据总条数变量(QH)
Dim iq1, h, iq2, iq3, i As Long 'FOR循环数量变量(QH)
Dim row As Long '查询数据存表起始变量(QH)
Dim lie1 As Long '查询结果总列数变量(QH)
Dim lie2 As Long '查询总数总列数变量(QH)
Dim n As Long '查询结果行数变量(QH)
Dim w As Long '进度条固定长度(QH)
Dim g As Single '进度条变动长度(QH)
Dim tiao1 As Long '批量查询条件最后行数变量(QH)
Dim zhusql1 As String '主SQL变量(QH)
Dim jishusql1 As String '计数SQL变量(QH)
Dim tiaojian1 As String '条件SQL变量(QH)
Dim tiaojian2 As String '批量条件SQL变量(QH)
Dim tiaojianzhi1 As String '批量条件值变量(QH)
Dim shujuku1, yonghu1, kouling1 As String '定义登录信息常量(QH)
Dim cnn As New ADODB.Connection '定义变量(QH)
Dim quehuirs2 As New ADODB.Recordset
shujuku1 = Sheets("login").Range("c3").Value
yonghu1 = Sheets("login").Range("c4").Value
kouling1 = Sheets("login").Range("c5").Value
With Sheets("CUX客户化编码")
zhusql1 = .Range("z3").Value '主SQL获取(QH)
jishusql1 = .Range("aa3").Value '计数SQL获取(QH)
If .Range("a3") = False Then '是否批量查询(QH)
If .Range("c4") = "" Then '验证含义名是否为空,为空则抛出提示并退出程序(QH)
MsgBox ("含义名为空则退出程序,阙辉提醒!")
Exit Sub
Else
For iq1 = 3 To 13
If .Cells(4, iq1) <> "" Then
tiaojian1 = tiaojian1 & .Cells(3, iq1) & " like" & " '" & .Cells(4, iq1) & "' " '组合查询的条件语句部分(QH)
End If
Next
End If
cnn.Open "Provider=msdaora;Data Source=" & shujuku1 & ";User Id=" & yonghu1 & ";Password=" & kouling1 & ";persist security info=true" '获取查询数据条数
sql = jishusql1 & " " & tiaojian1 '组合SQL脚本
quehuirs2.Open sql, cnn
Do Until quehuirs2.EOF
For iq2 = 1 To quehuirs2.Fields.Count
ztshu1 = quehuirs2.Fields(iq2 - 1).Value '总条数
Next
quehuirs2.MoveNext
Loop
Set quehuirs2 = Nothing
Set cnn = Nothing
cnn.Open "Provider=msdaora;Data Source=" & shujuku1 & ";User Id=" & yonghu1 & ";Password=" & kouling1 & ";persist security info=true" '查询数据
sql = zhusql1 & " " & tiaojian1 '组合SQL脚本
quehuirs2.Open sql, cnn
lie1 = quehuirs2.Fields.Count + 4
row = 5
On Error Resume Next
Do Until quehuirs2.EOF
row = row + 1
n = n + 1
.Cells(row, 2) = n
w = UserForm1.Label3.Width '获取文本框长度(QH)
UserForm1.Show 0 '显示窗口(QH)
g = g + w / ztshu1 '将文本框长度平均到条数(QH)
UserForm1.Label2.Width = g '实时更新文本框的长度(QH)
UserForm1.Label1 = "已完成" & Format((row - 5) / ztshu1, "0.00%") '文本框中央显示百分比(QH)
UserForm1.Caption = "正在运行,已耗时" & Format(Timer - t, "0.00") & "秒,请稍后!!!阙辉提醒~_~" '标题栏显示耗(QH)
DoEvents
For h = 3 To lie1
.Cells(row, h) = quehuirs2.Fields(h - 3).Value
Next h
quehuirs2.MoveNext
Loop
Set quehuirs2 = Nothing
Set cnn = Nothing
zhusql1 = ""
jishusql1 = ""
tiaojian1 = ""
Else
For iq3 = 3 To 13 '获取批量查询条件语句(QH)
If .Range("a5") = .Cells(2, iq3) Then
tiaojian2 = .Cells(3, iq3) & " in "
End If
Next
tiao1 = .Range("a65536").End(xlUp).row '获取查询数据最大行(QH)
If tiao1 - 5 = 1 Then '判断是否只有一条记录(QH)
tiaojianzhi1 = "('" & .Cells(tiao1, 1) & "')" '是一条记录则取此格式(QH)
Else '否则(QH)
If tiao1 - 5 = 2 Then '判断是否只有两条记录(QH)
tiaojianzhi1 = "('" & .Cells(tiao1 - 1, 1) & "'," & vbLf & "'" & .Cells(tiao1, 1) & "')" '是两条记录则取此格式(QH)
Else '否则(QH)
If tiao1 - 5 > 2 Then '判断是否大于三条记录(QH)
For i = 6 To tiao1
If i = 6 Then
tiaojianzhi1 = "('" & .Cells(i, 1) & "'," & vbLf
Else
If i <> tiao1 Then
tiaojianzhi1 = tiaojianzhi1 & "'" & .Cells(i, 1) & "'," & vbLf
Else
tiaojianzhi1 = tiaojianzhi1 & "'" & .Cells(tiao1, 1) & "')"
End If
End If
Next i
End If
End If
End If
cnn.Open "Provider=msdaora;Data Source=" & shujuku1 & ";User Id=" & yonghu1 & ";Password=" & kouling1 & ";persist security info=true" '获取查询数据条数
sql = jishusql1 & " " & tiaojian2 & " " & tiaojianzhi1 '组合SQL脚本
quehuirs2.Open sql, cnn
Do Until quehuirs2.EOF
For iq2 = 1 To quehuirs2.Fields.Count
ztshu1 = quehuirs2.Fields(iq2 - 1).Value '总条数
Next
quehuirs2.MoveNext
Loop
Set quehuirs2 = Nothing
Set cnn = Nothing
cnn.Open "Provider=msdaora;Data Source=" & shujuku1 & ";User Id=" & yonghu1 & ";Password=" & kouling1 & ";persist security info=true" '查询数据
sql = zhusql1 & " " & tiaojian2 & " " & tiaojianzhi1 '组合SQL脚本
quehuirs2.Open sql, cnn
lie1 = quehuirs2.Fields.Count + 4
row = 5
On Error Resume Next
Do Until quehuirs2.EOF
row = row + 1
n = n + 1
.Cells(row, 2) = n
w = UserForm1.Label3.Width '获取文本框长度(QH)
UserForm1.Show 0 '显示窗口(QH)
g = g + w / ztshu1 '将文本框长度平均到条数(QH)
UserForm1.Label2.Width = g '实时更新文本框的长度(QH)
UserForm1.Label1 = "已完成" & Format((row - 5) / ztshu1, "0.00%") '文本框中央显示百分比(QH)
UserForm1.Caption = "正在运行,已耗时" & Format(Timer - t, "0.00") & "秒,请稍后!!!阙辉提醒~_~" '标题栏显示耗(QH)
DoEvents
For h = 3 To lie1
.Cells(row, h) = quehuirs2.Fields(h - 3).Value
Next h
quehuirs2.MoveNext
Loop
Set quehuirs2 = Nothing
Set cnn = Nothing
zhusql1 = ""
jishusql1 = ""
tiaojian2 = ""
tiaojianzhi1 = ""
End If
End With
Unload UserForm1
End Sub
浙公网安备 33010602011771号