EBS对接系统的开发（Excel VBA连接Oracle数据库、Excel VBA连接MySQL数据库） 有三代
第一代 采用的是窗口gui的形式
功能：总控接口，新房各个业务模块的数据查询
只能单笔查询，不支持批量查询
以下是第一代的主要代码
------------------------------------------------------------------第一代代码，作者：阙辉---------------------------------------------------------------------------------
Option Explicit
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const WS_THICKFRAME As Long = &H40000 '(恢复大小)
Private Const WS_MINIMIZEBOX As Long = &H20000 '(最小化)
Private Const WS_MAXIMIZEBOX As Long = &H10000 '(最大化)
Public quehui1 As String '定义主级传递变量
Public quehui2 As String '定义次级传递变量
Public aa2, aa3, ii2, ii3 As Integer '定义传递变量
Public quehui3 As String
Public quehui4 As String
Public quehui5 As String
Public quehui6 As String
Public quehui7 As String
Public quehui8 As String
Public quehui9 As String
Public quehui10 As String
Public quehui11 As String
Private Sub UserForm_Initialize()
With oracle主页.数据库控制区.Frame4.MultiPage1.Page1
.Label1.Caption = "未标识"
.Label2.Caption = "未标识"
.Label3.Caption = "未标识"
.Label4.Caption = "未标识"
End With
oracle主页.数据库控制区.Frame1.主级.Clear
Dim aa1, ii1 As Integer
aa1 = Range("d2").End(xlToRight).Column
For ii1 = 4 To aa1
If Sheets("功能表").Cells(2, ii1).Value <> "" Then
oracle主页.数据库控制区.Frame1.主级.AddItem Sheets("功能表").Cells(2, ii1).Value
End If
Next
Dim hWndForm As Long
Dim IStyle As Long
hWndForm = FindWindow("ThunderDFrame", Me.Caption)
IStyle = GetWindowLong(hWndForm, GWL_STYLE)
IStyle = IStyle Or WS_THICKFRAME '还原
IStyle = IStyle Or WS_MINIMIZEBOX '最小化
'IStyle = IStyle Or WS_MAXIMIZEBOX '最大化
SetWindowLong hWndForm, GWL_STYLE, IStyle
End Sub
Private Sub CommandButton2_Click()
With oracle主页.Frame3.MultiPage2
.Page2.Spreadsheet1.Cells.Clear
.Page1.ListView1.ColumnHeaders.Clear
.Page1.ListView1.ListItems.Clear
End With
End Sub
Private Sub 主级_Click()
oracle主页.数据库控制区.Frame5.次级.Clear
With oracle主页.数据库控制区.Frame4.MultiPage1.Page1
.TextBox1 = ""
.TextBox2 = ""
.TextBox3 = ""
.TextBox4 = ""
End With
Dim aa2, aa3, ii2, ii3 As Integer
aa2 = Range("d3").End(xlToRight).Column
For ii2 = 4 To aa2
If Sheets("功能表").Cells(3, ii2).Value = oracle主页.数据库控制区.Frame1.主级.Value Then
aa3 = Sheets("功能表").Cells(10000, ii2).End(xlUp).Row
oracle主页.数据库控制区.Frame6.Label5.Caption = oracle主页.数据库控制区.Frame1.主级.Value
'Sheets("功能表").Cells(4, 2).Value = oracle主页.数据库控制区.Frame1.主级.Value
quehui1 = oracle主页.数据库控制区.Frame1.主级.Value
For ii3 = 5 To aa3
oracle主页.数据库控制区.Frame5.次级.AddItem Sheets("功能表").Cells(ii3, ii2).Value
Next
End If
Next
End Sub
Private Sub 次级_Click()
With oracle主页.数据库控制区.Frame4.MultiPage1.Page1
.TextBox1 = ""
.TextBox2 = ""
.TextBox3 = ""
.TextBox4 = ""
End With
Dim aa2, aa3, ii2, ii3 As Integer
aa2 = Range("d3").End(xlToRight).Column
For ii2 = 4 To aa2
'If Sheets("功能表").Cells(3, ii2).Value = Sheets("功能表").Cells(4, 2).Value Then
'If Sheets("功能表").Cells(3, ii2).Value = quehui1 Then
If Sheets("功能表").Cells(3, ii2).Value = oracle主页.数据库控制区.Frame1.主级.Value Then
aa3 = Sheets("功能表").Cells(10000, ii2).End(xlUp).Row
For ii3 = 5 To aa3
If Sheets("功能表").Cells(ii3, ii2).Value = oracle主页.数据库控制区.Frame5.次级.Value Then
Sheets("功能表").Cells(4, 3).Value = oracle主页.数据库控制区.Frame5.次级.Value
If Sheets("功能表").Cells(ii3, ii2 + 2).Value <> "" Then
oracle主页.数据库控制区.Frame4.MultiPage1.Page1.Label1.Caption = Sheets("功能表").Cells(ii3, ii2 + 2).Value
Else
oracle主页.数据库控制区.Frame4.MultiPage1.Page1.Label1.Caption = "未标识"
End If
If Sheets("功能表").Cells(ii3, ii2 + 4).Value <> "" Then
oracle主页.数据库控制区.Frame4.MultiPage1.Page1.Label2.Caption = Sheets("功能表").Cells(ii3, ii2 + 4).Value
Else
oracle主页.数据库控制区.Frame4.MultiPage1.Page1.Label2.Caption = "未标识"
End If
If Sheets("功能表").Cells(ii3, ii2 + 6).Value <> "" Then
oracle主页.数据库控制区.Frame4.MultiPage1.Page1.Label3.Caption = Sheets("功能表").Cells(ii3, ii2 + 6).Value
Else
oracle主页.数据库控制区.Frame4.MultiPage1.Page1.Label3.Caption = "未标识"
End If
If Sheets("功能表").Cells(ii3, ii2 + 8).Value <> "" Then
oracle主页.数据库控制区.Frame4.MultiPage1.Page1.Label4.Caption = Sheets("功能表").Cells(ii3, ii2 + 8).Value
Else
oracle主页.数据库控制区.Frame4.MultiPage1.Page1.Label4.Caption = "未标识"
End If
End If
Next
End If
Next
End Sub
Private Sub CommandButton1_Click()
Dim cnn As New ADODB.Connection
Dim quehuirs1 As New ADODB.Recordset
Dim sql As String
Dim i, k, j As Long
Dim ii1 As Long
Dim tiaojian1, tiaojian2 As String
cnn.Open "Provider=msdaora;Data Source=PROD;User Id=账号;Password=密码;persist security info=true"
aa2 = Range("d3").End(xlToRight).Column
For ii2 = 4 To aa2 '获取sql脚本
If Sheets("功能表").Cells(3, ii2).Value = oracle主页.数据库控制区.Frame1.主级.Value Then
aa3 = Sheets("功能表").Cells(10000, ii2).End(xlUp).Row
For ii3 = 5 To aa3
If Sheets("功能表").Cells(ii3, ii2).Value = oracle主页.数据库控制区.Frame5.次级.Value Then
quehui3 = Sheets("功能表").Cells(ii3, ii2 + 1).Value '获取主查询语句
If Sheets("功能表").Cells(ii3, ii2 + 3).Value <> "" Then
quehui4 = Sheets("功能表").Cells(ii3, ii2 + 3).Value
Else
quehui4 = ""
End If
If Sheets("功能表").Cells(ii3, ii2 + 5).Value <> "" Then
quehui5 = Sheets("功能表").Cells(ii3, ii2 + 5).Value
Else
quehui5 = ""
End If
If Sheets("功能表").Cells(ii3, ii2 + 7).Value <> "" Then
quehui6 = Sheets("功能表").Cells(ii3, ii2 + 7).Value
Else
quehui6 = ""
End If
If Sheets("功能表").Cells(ii3, ii2 + 7).Value <> "" Then
quehui7 = Sheets("功能表").Cells(ii3, ii2 + 9).Value
Else
quehui7 = ""
End If
End If
Next
End If
Next
With oracle主页.数据库控制区.Frame4.MultiPage1.Page1
If .TextBox1 = "" And .TextBox2 = "" And .TextBox3 = "" And .TextBox4 = "" Then
MsgBox "请至少输入一个条件（QH)"
Exit Sub
End If
For ii1 = 1 To 4 '循环组合查询条件和值（qh）
Select Case ii1
Case Is = 1
If .TextBox1 = "" Then
tiaojian1 = ""
Else
tiaojian1 = quehui4 & " '" & .TextBox1 & "' "
End If
Case Is = 2
If .TextBox2 = "" Then
tiaojian1 = ""
Else
tiaojian1 = quehui5 & " '" & .TextBox2 & "' "
End If
Case Is = 3
If .TextBox3 = "" Then
tiaojian1 = ""
Else
tiaojian1 = quehui6 & " '" & .TextBox3 & "' "
End If
Case Is = 4
If .TextBox4 = "" Then
tiaojian1 = ""
Else
tiaojian1 = quehui7 & " '" & .TextBox4 & "' "
End If
End Select
tiaojian2 = tiaojian2 & tiaojian1
Next ii1
sql = quehui3 & " " & tiaojian2
End With
quehuirs1.Open sql, cnn
' If quehui4 <> "" Then
' If .TextBox1 <> "" Then
' quehui8 = .TextBox1
' Else
' quehui8 = "%"
' End If
' Else
' quehui8 = ""
' End If
'
' If quehui5 <> "" Then
' If .TextBox2 <> "" Then
' quehui9 = .TextBox2
' Else
' quehui9 = "%"
' End If
' Else
' quehui9 = ""
' End If
'
' If quehui6 <> "" Then
' If .TextBox3 <> "" Then
' quehui10 = .TextBox3
' Else
' quehui10 = "%"
' End If
' Else
' quehui9 = ""
' End If
'
' If quehui7 <> "" Then
' If .TextBox4 <> "" Then
' quehui11 = .TextBox4
' Else
' quehui11 = "%"
' End If
' Else
' quehui11 = ""
' End If
'If quehui4 <> "" And quehui5 = "" And quehui6 = "" And quehui7 = "" Then
' sql = quehui3 & " " & quehui4 & " " & "'" & quehui8 & "'"
'Else
' If quehui4 <> "" And quehui5 <> "" And quehui6 = "" And quehui7 = "" Then
' sql = quehui3 & " " & quehui4 & " " & "'" & quehui8 & "'" & " " & quehui5 & " " & "'" & quehui9 & "'"
' Else
' If quehui4 <> "" And quehui5 <> "" And quehui6 <> "" And quehui7 = "" Then
' sql = quehui3 & " " & quehui4 & " " & "'" & quehui8 & "'" & " " & quehui5 & " " & "'" & quehui9 & "'" & " " & quehui6 & " " & "'" & quehui10 & "'"
' Else
' If quehui4 <> "" And quehui5 <> "" And quehui6 <> "" And quehui7 <> "" Then
' sql = quehui3 & " " & quehui4 & " " & "'" & quehui8 & "'" & " " & quehui5 & " " & "'" & quehui9 & "'" & " " & quehui6 & " " & "'" & quehui10 & "'" & " " & quehui7 & " " & "'" & quehui11 & "'"
' Else
' Exit Sub
' End If
' End If
' End If
'End If
'If quehui4 <> "" And quehui5 <> "" And quehui6 <> "" And quehui7 <> "" Then
' sql = quehui3 & " " & quehui4 & " " & "'" & quehui8 & "'" & " " & quehui5 & " " & "'" & quehui9 & "'" & " " & quehui6 & " " & "'" & quehui10 & "'" & " " & quehui7 & " " & "'" & quehui11 & "'"
'Else
' If quehui4 <> "" And quehui5 <> "" And quehui6 <> "" And quehui7 = "" Then
' sql = quehui3 & " " & quehui4 & " " & "'" & quehui8 & "'" & " " & quehui5 & " " & "'" & quehui9 & "'" & " " & quehui6 & " " & "'" & quehui10 & "'"
' Else
' If quehui4 <> "" And quehui5 <> "" And quehui6 = "" And quehui7 = "" Then
' sql = quehui3 & " " & quehui4 & " " & "'" & quehui8 & "'" & " " & quehui5 & " " & "'" & quehui9 & "'"
' Else
' If quehui4 <> "" And quehui5 = "" And quehui6 = "" And quehui7 = "" Then
' sql = quehui3 & " " & quehui4 & " " & "'" & quehui8 & "'"
' Else
' Exit Sub
' End If
' End If
' End If
'End If
'sql = quehui3 & " " & quehui4 & " " & "'" & quehui8 & "'" & " " & quehui5 & " " & "'" & quehui9 & "'" & " " & quehui6 & " " & "'" & quehui10 & "'" & " " & quehui7 & " " & "'" & quehui11 & "'"
With oracle主页.Frame3.MultiPage2
.Page2.Spreadsheet1.Cells.Clear
.Page1.ListView1.ColumnHeaders.Clear
.Page1.ListView1.ListItems.Clear
.Page1.ListView1.View = lvwReport
.Page1.ListView1.FullRowSelect = True
.Page1.ListView1.Gridlines = True
' .Page1.ListView1.BackColor = &HE0E0E0
.Page1.ListView1.ForeColor = &HFF0000
.Page1.ListView1.Font = "华文楷体"
.Page1.ListView1.Font.Size = 12
For i = 1 To quehuirs1.Fields.Count
.Page1.ListView1.ColumnHeaders.Add , , quehuirs1.Fields(i - 1).Name
.Page2.Spreadsheet1.Cells(1, i) = quehuirs1.Fields(i - 1).Name
Next i
On Error Resume Next
Do Until quehuirs1.EOF
k = k + 1
.Page1.ListView1.ListItems.Add , , quehuirs1.Fields(0).Value
For j = 1 To quehuirs1.Fields.Count
.Page1.ListView1.ListItems(k).SubItems(j - 1) = quehuirs1.Fields(j - 1).Value
.Page2.Spreadsheet1.Cells(k + 1, j) = quehuirs1.Fields(j - 1).Value
Next j
quehuirs1.MoveNext
Loop
End With
quehui1 = ""
quehui2 = ""
quehui3 = ""
quehui4 = ""
quehui5 = ""
quehui6 = ""
quehui7 = ""
quehui8 = ""
quehui9 = ""
quehui10 = ""
quehui11 = ""
Set quehuirs1 = Nothing
Set cnn = Nothing
End Sub
Private Sub CommandButton3_Click()
Dim cnn As New ADODB.Connection
Dim quehuirs1 As New ADODB.Recordset
Dim sql As String
Dim i, k, j As Long
cnn.Open "Provider=msdaora;Data Source=PROD;User Id=账号;Password=密码;persist security info=true"
sql = Sheets("功能表").Range("e3")
quehuirs1.Open sql, cnn
With oracle主页.Frame3.MultiPage2
.Page2.Spreadsheet1.Cells.Clear
.Page1.ListView1.ColumnHeaders.Clear
.Page1.ListView1.ListItems.Clear
.Page1.ListView1.View = lvwReport
.Page1.ListView1.FullRowSelect = True
.Page1.ListView1.Gridlines = True
' .Page1.ListView1.BackColor = &HE0E0E0
.Page1.ListView1.ForeColor = &HFF0000
.Page1.ListView1.Font = "华文楷体"
.Page1.ListView1.Font.Size = 12
For i = 1 To quehuirs1.Fields.Count
.Page1.ListView1.ColumnHeaders.Add , , quehuirs1.Fields(i - 1).Name
.Page2.Spreadsheet1.Cells(1, i) = quehuirs1.Fields(i - 1).Name
Next i
On Error Resume Next
Do Until quehuirs1.EOF
k = k + 1
.Page1.ListView1.ListItems.Add , , quehuirs1.Fields(0).Value
For j = 1 To quehuirs1.Fields.Count
.Page1.ListView1.ListItems(k).SubItems(j - 1) = quehuirs1.Fields(j - 1).Value
.Page2.Spreadsheet1.Cells(k + 1, j) = quehuirs1.Fields(j - 1).Value
Next j
quehuirs1.MoveNext
Loop
End With
End Sub
Private Sub CommandButton5_Click()
Dim cnn As New ADODB.Connection
Dim quehuirs1 As New ADODB.Recordset
Dim sql As String
Dim i, k, j As Long
cnn.Open "Provider=msdaora;Data Source=PROD;User Id=账号;Password=密码;persist security info=true"
sql = Sheets("功能表").Range("f3")
quehuirs1.Open sql, cnn
With oracle主页.Frame3.MultiPage2
.Page2.Spreadsheet1.Cells.Clear
.Page1.ListView1.ColumnHeaders.Clear
.Page1.ListView1.ListItems.Clear
.Page1.ListView1.View = lvwReport
.Page1.ListView1.FullRowSelect = True
.Page1.ListView1.Gridlines = True
' .Page1.ListView1.BackColor = &HE0E0E0
.Page1.ListView1.ForeColor = &HFF0000
.Page1.ListView1.Font = "华文楷体"
.Page1.ListView1.Font.Size = 12
For i = 1 To quehuirs1.Fields.Count
.Page1.ListView1.ColumnHeaders.Add , , quehuirs1.Fields(i - 1).Name
.Page2.Spreadsheet1.Cells(1, i) = quehuirs1.Fields(i - 1).Name
Next i
On Error Resume Next
Do Until quehuirs1.EOF
k = k + 1
.Page1.ListView1.ListItems.Add , , quehuirs1.Fields(0).Value
For j = 1 To quehuirs1.Fields.Count
.Page1.ListView1.ListItems(k).SubItems(j - 1) = quehuirs1.Fields(j - 1).Value
.Page2.Spreadsheet1.Cells(k + 1, j) = quehuirs1.Fields(j - 1).Value
Next j
quehuirs1.MoveNext
Loop
End With
End Sub
Private Sub CommandButton6_Click()
Dim cnn As New ADODB.Connection
Dim quehuirs1 As New ADODB.Recordset
Dim sql As String
Dim i, k, j As Long
cnn.Open "Provider=msdaora;Data Source=QFANG_UAT;User Id=账号;Password=密码;persist security info=true"
sql = Sheets("功能表").Range("f3")
quehuirs1.Open sql, cnn
With oracle主页.Frame3.MultiPage2
.Page2.Spreadsheet1.Cells.Clear
.Page1.ListView1.ColumnHeaders.Clear
.Page1.ListView1.ListItems.Clear
.Page1.ListView1.View = lvwReport
.Page1.ListView1.FullRowSelect = True
.Page1.ListView1.Gridlines = True
' .Page1.ListView1.BackColor = &HE0E0E0
.Page1.ListView1.ForeColor = &HFF0000
.Page1.ListView1.Font = "华文楷体"
.Page1.ListView1.Font.Size = 12
For i = 1 To quehuirs1.Fields.Count
.Page1.ListView1.ColumnHeaders.Add , , quehuirs1.Fields(i - 1).Name
.Page2.Spreadsheet1.Cells(1, i) = quehuirs1.Fields(i - 1).Name
Next i
On Error Resume Next
Do Until quehuirs1.EOF
k = k + 1
.Page1.ListView1.ListItems.Add , , quehuirs1.Fields(0).Value
For j = 1 To quehuirs1.Fields.Count
.Page1.ListView1.ListItems(k).SubItems(j - 1) = quehuirs1.Fields(j - 1).Value
.Page2.Spreadsheet1.Cells(k + 1, j) = quehuirs1.Fields(j - 1).Value
Next j
quehuirs1.MoveNext
Loop
End With
End Sub
------------------------------------------------------------------第一代代码，作者：阙辉---------------------------------------------------------------------------------
第二代 采用的是Excel表格形式交互，主要支持的批量查询
功能：和第一代基本报错一致，主要就是批量查询
------------------------------------------------------------------第二代代码，作者：阙辉---------------------------------------------------------------------------------
批量查询显示表 事件动态代码
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Dim d2, d3, vv2, vv3, vv4, vv5 As Long '定义变量 d2主级最右端个数 d3次级下最大行数 vv2循环主级所在列 vv4循环次级所在行 vv5循环并组合序列(QH)
d2 = Sheets("批量查询脚本表").Range("iv3").End(xlToLeft).Column '获取主级栏最右端个数(QH)
If Target.Column = 3 And Target.row = 2 Then '如果sheet7.range(c2)有变动(QH)
Sheets("批量查询显示表").Range("c3").Validation.Delete '清空sheet7.range(c3)序列(QH)
Sheets("批量查询显示表").Range("c3").ClearContents '清空sheet7.range(c3)数据(QH)
' Sheets("批量查询显示表").Range("d11:iv100000").ClearContents '清空sheet7查询的结果数据(QH)
For vv2 = 4 To d2 'for循环查找主级所在列(QH)
If Sheets("批量查询脚本表").Cells(3, vv2).Value = Sheets("批量查询显示表").Cells(2, 3).Value Then '如果如果sheet7.range(c2)数值和主级相同(QH)
d3 = Sheets("批量查询脚本表").Cells(60000, vv2).End(xlUp).row '获取主级下次级最大行数(QH)
With Sheets("批量查询脚本表")
For vv3 = 5 To d3 'for循环获取次级序列值(QH)
xulie2 = xulie2 & .Cells(vv3, vv2) & "," '组合次级序列值(QH)
Next
End With
With Sheets("批量查询显示表").Range("c3").Validation
.Delete '再次清空序列(QH)
.Add Type:=xlValidateList, Formula1:=xulie2 '将序列赋值给sheet7.range(c3)(QH)
End With
End If
Next vv2
Else '如果sheet7.range(c2)无变动
If Target.Column = 3 And Target.row = 3 Then '如果sheet7.range(c3)变动
Sheets("批量查询显示表").Range("c4").Validation.Delete '清空sheet7.range(c4)序列(QH)
Sheets("批量查询显示表").Range("c4").ClearContents '清空sheet7.range(c4)数据(QH)
' Sheets("批量查询显示表").Range("d11:iv100000").ClearContents '清空sheet7查询的结果数据(QH)
For vv2 = 4 To d2 'for循环查找主级所在列(QH)
If Sheets("批量查询脚本表").Cells(3, vv2).Value = Sheets("批量查询显示表").Cells(2, 3).Value Then '如果如果sheet7.range(c2)数值和主级相同(QH)
d3 = Sheets("批量查询脚本表").Cells(60000, vv2).End(xlUp).row '获取主级下次级最大行数(QH)
For vv4 = 5 To d3 'for循环获取条件序列值(QH)
If Sheets("批量查询脚本表").Cells(vv4, vv2).Value = Sheets("批量查询显示表").Cells(3, 3).Value Then '如果如果sheet7.range(c3)数值和次级相同(QH)
For vv5 = vv2 + 3 To vv2 + 6
xulie3 = xulie3 & Sheets("批量查询脚本表").Cells(vv4, vv5) & ","
Next vv5
With Sheets("批量查询显示表").Range("c4").Validation
.Delete '再次清空序列(QH)
.Add Type:=xlValidateList, Formula1:=xulie3 '将序列赋值给sheet7.range(c4)(QH)
End With
End If
Next vv4
End If
Next vv2
Else
If Target.Column = 3 And Target.row = 4 Then
Sheets("批量查询显示表").Range("c12:c100000").ClearContents '清空条件数据(QH)
Sheets("批量查询显示表").Range("d11:iv100000").ClearContents
End If
End If
End If
Application.ScreenUpdating = ture
End Sub
批量查询主代码
Sub 关键查询001()
't = Timer
Sheets("批量查询显示表").Range("d11:iv100000").ClearContents '清空sheet7查询的结果数据(QH)
'Sheets("批量查询显示表").Range("d11:iv100000").NumberFormatLocal = "@"
Dim ax1, ax2, ax3, iv1, iv2, iv3, aa, qh1 As Long
Dim qhwt1, qhwt2, qhwt3 As String '定义变量(QH)
Dim qh3, qhsh2, i, k, q, h, g, row As Long '定义变量(QH)
Dim qhs1 As String '定义变量(QH)
Dim cnn As New ADODB.Connection '定义变量(QH)
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
CUX客户化编码 单功能
CUX客户化编码 单功能 代码
Sub cuxkehuhuachaxun()
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
CUX支付申请 功能
CUX支付申请 功能代码
Sub cuxkehuhuachaxun001()
t = Timer
Sheets("CUX支付申请").Range("b6:ah1000000").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, sql As Variant '主SQL变量(QH)
Dim jishusql1 As Variant '计数SQL变量(QH)
Dim tiaojian1 As Variant '条件SQL变量(QH)
Dim tiaojian2 As Variant '批量条件SQL变量(QH)
Dim tiaojianzhi1 As Variant '批量条件值变量(QH)
Dim shujuku1, yonghu1, kouling1 As String '定义登录信息常量(QH)
Dim cnn As New ADODB.Connection '定义变量(QH)
Dim quehuirs2 As New ADODB.Recordset
Dim qh001 As Long
Dim qh1 As Long
shujuku1 = Sheets("login").Range("c3").Value
yonghu1 = Sheets("login").Range("c4").Value
kouling1 = Sheets("login").Range("c5").Value
qh001 = 32
With Sheets("CUX支付申请")
zhusql1 = .Range("ap3").Value '主SQL获取(QH)
jishusql1 = .Range("aq3").Value '计数SQL获取(QH)
If .Range("a3") = False Then '是否批量查询(QH)
If .Range("c4") = "" Then '验证含义名是否为空，为空则抛出提示并退出程序(QH)
MsgBox ("含义名为空则退出程序,阙辉提醒！")
Exit Sub
Else
For iq1 = 3 To qh001 + 2
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脚本
' .Range("c1") = 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 qh001 + 2 '获取批量查询条件语句(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号