VBA для pu sh данных в базу данных

Question

У меня есть таблица данных с несколькими столбцами: GLID, Metri c Category, Amount и Metri c Date. То, как данные организованы в файле Excel, который мне нужно использовать, похоже на матрицу:

Столбцы даты - это метрическая дата c и цифры ниже. это суммы. Как вы можете видеть на каждую дату, есть некоторая сумма, относящаяся к определенной категории метри c и в некоторых случаях GLID. Теперь, что мне нужно сделать в VBA - это вывести sh данные в такой формат:

GLID       Metric Category         Amount          Metric Date
5500       Property Tax-5500        -8               3/31/2020
5500       Property Tax-5500        -8               4/30/2020

Итак, и так далее. Я совершенно новичок в VBA, так что эта конкретная задача является сложной для меня и, следовательно, почему я сделал пост здесь. Если у кого-то есть какие-то предложения, я был бы очень признателен.

Пока что у меня есть настройки VBA:

Sub second_export()
Dim sSQL As String, sCnn As String, sServer As String
    Dim db As Object, rs As Object
    sServer = "CATHCART"
    sCnn = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=Portfolio_Analytics;Data Source=" & sServer & ";" & _
              "Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;"

    Set db = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    If db.State = 0 Then db.Open sCnn




End Sub

Примечание Для дальнейшего уточнения:

Количество столбцов равно 36, а количество строк - 46 в файле Excel. Для категорий, которые не имеют GLID, мы можем при необходимости вывести pu sh NULL.

Я могу вывести данные sh в базу данных, когда их просто и вставить, но мне нужно повернуть данные таким образом, чтобы категории GLID и Metri c повторяются для соответствующих дат и сумм.

Answer 1

Сначала создайте лист данных для загрузки

Option Explicit
Sub CreateDataSheet()

    Dim wb As Workbook, ws As Worksheet, wsData As Worksheet, header As Variant
    Dim iLastRow, iLastCol, dt As Variant, iOutRow
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Sheet1") ' the matrix sheet
    Set wsData = wb.Sheets("Sheet2") ' sheet to hold table data

    wsData.Cells.Clear
    wsData.Range("A1:D1") = Array("GLID", "Metric Category", "Amount", "Metric Date")

    ' get header
    iLastCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column
    iLastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    header = ws.Range(ws.Cells(1, 3), ws.Cells(1, iLastCol))
    'Debug.Print iLastRow, iLastCol, UBound(header, 2)

    Dim r, c
    iOutRow = 2
    For r = 2 To iLastRow
        For c = 1 To UBound(header, 2)
            'Debug.Print r, header(1, c), ws.Cells(r, c + 2)
            With wsData.Cells(iOutRow, 1)
                .Offset(0, 0) = ws.Cells(r, 1)
                .Offset(0, 1) = ws.Cells(r, 2)
                .Offset(0, 2) = ws.Cells(r, c + 2)
                .Offset(0, 3) = header(1, c)
            End With
            iOutRow = iOutRow + 1
        Next
    Next
    wsData.Range("A1").Select
    MsgBox iOutRow - 2 & " Rows created on " & wsData.Name, vbInformation

End Sub

Затем создайте таблицу в базе данных

Sub CreateTable()

    Const TABLE_NAME = "dbo.GL_TEST"
    Dim SQL As String, con As Object

    SQL = "CREATE TABLE " & TABLE_NAME & "( " & vbCr & _
          "RECNO int NOT NULL," & vbCr & _
          "GLID nchar(10)," & vbCr & _
          "METRICNAME nvarchar(255)," & vbCr & _
          "AMOUNT money," & vbCr & _
          "METRICDATE date," & vbCr & _
          "PRIMARY KEY (RECNO))"

     'Debug.Print sql
     Set con = mydbConnect()
     'con.Execute ("DROP TABLE " & TABLE_NAME) ' use during testing
     con.Execute SQL
     con.Close
     Set con = Nothing

     MsgBox "Table " & TABLE_NAME & " created"

End Sub

, используя подключение к данным.

Function mydbConnect() As Object
    Dim sConStr As String

    Const sServer = "CATHCART"
    sConStr = "Provider=SQLOLEDB.1;" & _
              "Integrated Security=SSPI;" & _
              "Persist Security Info=True;" & _
              "Initial Catalog=Portfolio_Analytics;" & _
              "Data Source=" & sServer & ";" & _
              "Use Procedure for Prepare=1;" & _
              "Auto Translate=True;Packet Size=4096;"

    Set mydbConnect = CreateObject("ADODB.Connection")
    mydbConnect.Open sConStr

End Function    

Затем загружать данные с листа по одной записи за раз с отключенной автоматической фиксацией.

Sub LoadData()

    Const TABLE_NAME = "dbo.GL_TEST"

    Dim SQL As String
    SQL = " INSERT INTO " & TABLE_NAME & _
          " (RECNO,GLID,METRICNAME,AMOUNT,METRICDATE) VALUES (?,?,?,?,?) "

    Dim con As Object, cmd As Object, rs As Variant
    Set con = mydbConnect()
    Set cmd = CreateObject("ADODB.Command")

    With cmd
        .ActiveConnection = con
        .CommandType = adCmdText
        .CommandText = SQL
        .Parameters.Append .CreateParameter("P1", adInteger, adParamInput)
        .Parameters.Append .CreateParameter("P2", adVarWChar, adParamInput, 10)
        .Parameters.Append .CreateParameter("P3", adVarWChar, adParamInput, 255)
        .Parameters.Append .CreateParameter("P4", adCurrency, adParamInput)
        .Parameters.Append .CreateParameter("P5", adDate, adParamInput)
    End With

    con.Execute "SET IMPLICIT_TRANSACTIONS ON"

    Dim ws As Worksheet, iLastRow As Long, i As Long
    Set ws = ThisWorkbook.Sheets("Sheet2") ' sheet were table data is
    iLastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To iLastRow
        cmd.Parameters(0).Value = i
        cmd.Parameters(1).Value = ws.Cells(i, 1)
        cmd.Parameters(2).Value = ws.Cells(i, 2)
        cmd.Parameters(3).Value = ws.Cells(i, 3)
        cmd.Parameters(4).Value = ws.Cells(i, 4)
        cmd.Execute
    Next

    con.Execute "COMMIT"
    con.Execute "SET IMPLICIT_TRANSACTIONS OFF"

    rs = con.Execute("SELECT COUNT(*) FROM " & TABLE_NAME)
    MsgBox rs(0) & " Rows are in " & TABLE_NAME, vbInformation

    con.Close
    Set con = Nothing

End Sub

Answer 2

Вот как вы можете l oop над вашими данными:

Sub Tester()

    Dim rw As Range, n As Long
    Dim GLID, category, dt, amount

    For Each rw In ActiveSheet.Range("H2:AS47").Rows 

        'fixed per-row
        GLID = Trim(rw.Cells(1).Value)
        category = Trim(rw.Cells(2).Value)

        'loopover the date columns
        For n = 3 To rw.Cells.Count

            dt = rw.Cells(n).EntireColumn.Cells(1).Value 'date from Row 1
            amount = rw.Cells(n).Value

            Debug.Print rw.Cells(n).Address, GLID, category, amount, dt

            'insert a record using your 4 values
            'switch GLID to null if empty

        Next n
    Next rw

End Sub