Код для извлечения данных из оракула в Excel и отправки данных с одинаковым именем ячейки на разные листы в Excel

Question

Ниже приведен код VB для извлечения данных из базы данных Oracle для превосходства.

Вкладка COLLABNAME из таблицы TABLE_NAME имеет 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

Я только что сохранил код только для двух КОЛЛАБЛЕЙ

Я хочудобавить цикл, содержащий COLLABNAME1, COLLABNAME2, COLLABNAME3, COLLABNAME4 ... COLLABNAME20, чтобы данные, которые выбираются на 20 различных листах из таблицы TABLE_NAME, уменьшают длину кода и выглядят более элегантно

Заранее спасибо

Answer 1

Просто создайте новый Sub, который выполняет общую часть.

Это не проверенный код, но он должен работать (или вам может потребоваться исправить незначительные проблемы).

   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

EDIT:

Если 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

Answer 2

Если у вас много COLLABNAME и вы действительно хотите использовать цикл, вы можете использовать цикл, загрузив имена листов в массив строк, а затем циклически пройдя.

Dim strArrNames(1 to 20) as string
strArrNames = array("A", "B", ..."T")Dim i as Long

For i = 1 To 20
Load_data_into_sheet Sheets("Sheet" & i), strArrNames(i), cn
Next