以下是从oracle数据库读取数据到excel的VB代码。
表 TABLE_NAME 中的 COLLABNAME 选项卡有 20 个不同的协作名称,我想将每个协作对应的数据发送到从sheet1 开始的不同工作表
目前我计划编写相同的代码20次,并将数据获取到不同的工作表,代码如下所示
当前代码:
Sub Load_data()
Sheets("Sheet1").Select
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim col As Integer
Dim row As Integer
Dim Query As String
Dim mtxData As Variant
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
cn.Open ( _
"User ID=USERID" & _
";Password=PASSWORD" & _
";Data Source=xx.xx.xx.xxx:xxxx/xxxx" & _
";Provider=OraOLEDB.Oracle")
rs.Open "select COLLABNAME,DATETIME,TOTALFLOWS from TABLE_NAME WHERE to_date(DATETIME, 'DDMMYYYY HH24:MI') BETWEEN case when to_char(sysdate, 'dd') > 7 then trunc(sysdate-7) else trunc(sysdate,'mm') end AND trunc(sysdate) AND COLLABNAME like 'COLLABNAME1' ORDER BY DATETIME ASC", cn
With Sheet1
col = 0
'First Row: names of columns
Do While col < rs.Fields.Count
.Cells(1, col + 1) = rs.Fields(col).Name
col = col + 1
Loop
mtxData = Application.Transpose(rs.GetRows)
.Range("A2").Resize(UBound(mtxData, 1) - LBound(mtxData, 1) + 1, UBound(mtxData, 2) - LBound(mtxData, 2) + 1) = mtxData
End With
rs.Close
rs.Open "select COLLABNAME,DATETIME,TOTALFLOWS from TABLE_NAME WHERE to_date(DATETIME, 'DDMMYYYY HH24:MI') BETWEEN case when to_char(sysdate, 'dd') > 7 then trunc(sysdate-7) else trunc(sysdate,'mm') end AND trunc(sysdate) AND COLLABNAME like 'COLLABNAME2' ORDER BY DATETIME ASC", cn
With Sheet2
col = 0
'First Row: names of columns
Do While col < rs.Fields.Count
.Cells(1, col + 1) = rs.Fields(col).Name
col = col + 1
Loop
mtxData = Application.Transpose(rs.GetRows)
.Range("A2").Resize(UBound(mtxData, 1) - LBound(mtxData, 1) + 1, UBound(mtxData, 2) - LBound(mtxData, 2) + 1) = mtxData
End With
rs.Close
End Sub
我只保留了两个 COLLABNAMES 的代码
我想添加一个包含 COLLABNAME1、COLLABNAME2、COLLABNAME3、COLLABNAME4 的循环 ...COLLABNAME20,以便从表 TABLE_NAME 中提取到 20 个不同的工作表中的数据,这减少了代码长度并且更加优雅
提前致谢
最佳答案
只需创建一个新的 Sub 来完成公共(public)部分。
这不是经过测试的代码,但应该可以工作(或者您可能需要纠正小问题)。
Sub Load_data()
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
cn.Open ( _
"User ID=USERID" & _
";Password=PASSWORD" & _
";Data Source=xx.xx.xx.xxx:xxxx/xxxx" & _
";Provider=OraOLEDB.Oracle")
Dim i as Long
For i = 1 To 20
Load_data_into_sheet Sheets("Sheet" & i), "COLLABNAME" & i, cn
Next
cn.close
End Sub
Private Sub Load_data_into_sheet(ws as WorkSheet, CollabName as String, cn as ADODB.Connection)
ws.Select
Dim rs As ADODB.Recordset
Dim col As Integer
Dim row As Integer
Dim Query As String
Dim mtxData As Variant
Set rs = New ADODB.Recordset
rs.Open "select COLLABNAME,DATETIME,TOTALFLOWS from TABLE_NAME WHERE to_date(DATETIME, 'DDMMYYYY HH24:MI') BETWEEN case when to_char(sysdate, 'dd') > 7 then trunc(sysdate-7) else trunc(sysdate,'mm') end AND trunc(sysdate) AND COLLABNAME like '" & CollabName & "' ORDER BY DATETIME ASC", cn
With ws
col = 0
'First Row: names of columns
Do While col < rs.Fields.Count
.Cells(1, col + 1) = rs.Fields(col).Name
col = col + 1
Loop
mtxData = Application.Transpose(rs.GetRows)
.Range("A2").Resize(UBound(mtxData, 1) - LBound(mtxData, 1) + 1, UBound(mtxData, 2) - LBound(mtxData, 2) + 1) = mtxData
End With
rs.Close
End Sub
编辑:
如果COLLABNAME没有固定格式,则不能使用循环。在这种情况下,您需要单独调用其中每一个。 其格式如下:
Load_data_into_sheet _SheetToFill_ , _COLLABNAME_ , cn
例如
Sub Load_data()
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
cn.Open ( _
"User ID=USERID" & _
";Password=PASSWORD" & _
";Data Source=xx.xx.xx.xxx:xxxx/xxxx" & _
";Provider=OraOLEDB.Oracle")
Load_data_into_sheet Sheets("Sheet1"), "COLLABNAME1_01", cn
Load_data_into_sheet Sheets("Sheet2"), "Collab_NAme2_02", cn
Load_data_into_sheet Sheets("Sheet3"), "Collab_NAME1_NAME2", cn
' -- more statements goes here --
cn.close
End Sub
关于vba - 从oracle获取数据到excel并将具有相同单元格名称的数据发送到excel中不同工作表的代码,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/9922716/