阙辉

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


posted on 2018-04-23 14:50  真辉辉  阅读(159)  评论(0)    收藏  举报

导航