vba - 从oracle获取数据到excel并将具有相同单元格名称的数据发送到excel中不同工作表的代码

标签 vba excel oracle10g excel-2007

以下是从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/

相关文章:

vba - 如何将当前对象 (Me) 设置为存储在 Visual Basic for Excel 中的数组中的新对象

VBA:在选择是图表的工作表中获取选定的范围

excel - VBA 将不同工作簿中的自动筛选器设置为对所有列选择全部

excel - 连接两列之间的排列

sql - ORA-12801 : error signaled in parallel query server P004 and ORA-01555: snapshot too old

vba - Excel VBA 类型不匹配 (13)

vba - ADODB查询超时

javascript - 分区 :hover works oddly in IE-8

plsql - 如何使用 pl/sql refcursor 创建交互式报告

java - Oracle jdbc 驱动程序 : implicit statement cache or setPoolable(true)?