4.批量查询（批量查询模块-功能代码）

Dim quehuirs1 As New ADODB.Recordset        '定义变量(QH)
qh1 = Sheets("批量查询显示表").Range("c65536").End(xlUp).row       '获取查询数据最大行(QH)
Dim sql As String
If qh1 - 11 > 1000 Then
    MsgBox ("条件数量超过范围(1000),阙辉提醒！")
Else
ax1 = Sheets("批量查询脚本表").Range("iv3").End(xlToLeft).Column
    For iv1 = 4 To ax1
        If Sheets("批量查询脚本表").Cells(3, iv1).Value = Sheets("批量查询显示表").Range("c2").Value Then
            ax2 = Sheets("批量查询脚本表").Cells(60000, iv1).End(xlUp).row
            For iv2 = 5 To ax2
                 If Sheets("批量查询脚本表").Cells(iv2, iv1).Value = Sheets("批量查询显示表").Range("c3").Value Then
                    For iv3 = iv1 + 3 To iv1 + 6
                        If Sheets("批量查询脚本表").Cells(iv2, iv3).Value = Sheets("批量查询显示表").Range("c4").Value Then
                        qhwt1 = Sheets("批量查询脚本表").Cells(iv2, iv1 + 1).Value
                        qhwt2 = Sheets("批量查询脚本表").Cells(iv2, iv1 + 2).Value
                        qhwt3 = Sheets("批量查询脚本表").Cells(iv2, iv3 + 4).Value
                        
                            With Sheets("批量查询显示表")
                            qh1 = .Range("c65536").End(xlUp).row       '获取查询数据最大行(QH)
                                If qh1 - 11 = 1 Then    '判断是否只有一条记录(QH)
                                    qhs1 = "('" & .Cells(qh1, 3) & "')"        '是一条记录则取此格式(QH)
                                Else        '否则(QH)
                                    If qh1 - 11 = 2 Then     '判断是否只有两条记录(QH)
                                        qhs1 = "('" & .Cells(qh1 - 1, 3) & "'," & vbLf & "'" & .Cells(qh1, 3) & "')"      '是两条记录则取此格式(QH)
                                    Else    '否则(QH)
                                        If qh1 - 11 > 2 Then     '判断是否大于三条记录(QH)
                                            For i = 12 To qh1
                                                If i = 12 Then
                                                    qhs1 = "('" & .Cells(i, 3) & "'," & vbLf
                                                Else
                                                    If i <> qh1 Then
                                                        qhs1 = qhs1 & "'" & .Cells(i, 3) & "'," & vbLf
                                                    Else
                                                        qhs1 = qhs1 & "'" & .Cells(qh1, 3) & "')"
                                                    End If
                                                End If
                                            Next i
                                       End If
                                    End If
                                End If
                                
                               t = Timer
                               cnn.Open "Provider=msdaora;Data Source=PROD;User Id=用户;Password=密码;persist security info=true"    '获取查询数据条数
                               sql = qhwt2 & " " & qhwt3 & " " & qhs1 '组合SQL脚本
                               quehuirs1.Open sql, cnn
                                    Do Until quehuirs1.EOF
                                        For k = 1 To quehuirs1.Fields.Count
                                            qhsh2 = quehuirs1.Fields(k - 1).Value       '总条数
                                        Next
                                        quehuirs1.MoveNext
                               Loop
                               Set quehuirs1 = Nothing
                               Set cnn = Nothing
                               
                               cnn.Open "Provider=msdaora;Data Source=PROD;User Id=用户;Password=密码;persist security info=true"     '查询数据
                               sql = qhwt1 & " " & qhwt3 & " " & qhs1  '组合SQL脚本
                               quehuirs1.Open sql, cnn
                                    aa = quehuirs1.Fields.Count + 4
                                    For q = 5 To aa
                                        .Cells(11, q) = quehuirs1.Fields(q - 5).Name
                                        Next q
                                        row = 11
                                        On Error Resume Next
                                        Do Until quehuirs1.EOF
                                        row = row + 1
                                        n = n + 1
                                        .Cells(row, 4) = n
                                        w = UserForm1.Label3.Width      '获取文本框长度(QH)
                                        UserForm1.Show 0     '显示窗口(QH)
                                        g = g + w / qhsh2       '将文本框长度平均到条数(QH)
                                        UserForm1.Label2.Width = g      '实时更新文本框的长度(QH)
                                        UserForm1.Label1 = "已完成" & Format((row - 11) / qhsh2, "0.00%")        '文本框中央显示百分比(QH)
                                        UserForm1.Caption = "正在运行，已耗时" & Format(Timer - t, "0.00") & "秒，请稍后！！！阙辉提醒~_~"      '标题栏显示耗(QH)
                                        DoEvents
                                        
                                        For h = 5 To aa
                                            .Cells(row, h) = quehuirs1.Fields(h - 5).Value
                                        Next h
                                            quehuirs1.MoveNext
                                        Loop
                                        Set quehuirs1 = Nothing
                                        Set cnn = Nothing
                               End With
                        Exit For
                        End If
                    Next iv3
                 Exit For
                 End If
            Next iv2
        Exit For
        End If
    Next iv1
'    MsgBox (Timer - t)

qhwt1 = ""
qhwt2 = ""
qhwt3 = ""
ax1 = ""
ax2 = ""
ax3 = ""
iv1 = ""
iv2 = ""
iv3 = ""
aa = ""
qh1 = ""
End If
Unload UserForm1
End Sub