** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Access y VBA > Tus Funciones Favoritas & Aportaciones & Artí­culos
  Mensajes nuevos Mensajes nuevos RSS - VBA: Denormalizar Tablas
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

Tema cerradoVBA: Denormalizar Tablas

 Responder Responder
Autor
Mensaje
genoma111 Ver desplegable
Administrador
Administrador
Avatar

Unido: 28/Marzo/2011
Localización: ...
Estado: Sin conexión
Puntos: 3248
Enlace directo a este mensaje Tema: VBA: Denormalizar Tablas
    Enviado: 20/Agosto/2013 a las 21:56
En ocasiones se nos exige presentar tablas denormalizadas para cumplir con algún esquema determinado.

Dado que el mantenimiento de nuestras bases de datos y su correcto funcionamiento dependen en gran medida de la adherencia a unos mínimos de normalización no es aconsejable trabajar sobre tablas denormalizadas usualmente.

Sin embargo, la presentación de datos de manera denormalizada a veces se complica y lo más fácil es recrear una tabla que presente los datos de dicha manera para cumplir con una tarea específica.

Por ejemplo, la siguiente tabla:
Mi_Tabla
ID Vendedor Ciudad Importe_Ventas
1 1 Cali $5.00
2 1 Bogota $10.00
3 2 Medellin $15.00
4 2 Bogota $20.00
5 3 Buenaventura $25.00
6 3 Cartagena $30.00
7 4 Bogota $35.00
8 4 Manizales $40.00
9 5 Bogota $45.00
10 5 Pereira $50.00
11 6 Bogota $55.00

Puedo necesitar presentarla de la siguiente manera:

Mi_Tabla_Denormalizada
Vendedor Ciudad1 Importe_Ventas1 Ciudad2 Importe_Ventas2
1 Cali $5.00 Bogota $10.00
2 Medellin $15.00 Bogota $20.00
3 Buenaventura $25.00 Cartagena $30.00
4 Bogota $35.00 Manizales $40.00
5 Bogota $45.00 Pereira $50.00
6Bogota$55.00


Para ello he construido el código que muestro a continuación.

Uso:

Private Sub Command0_Click()
    Dim w()
    Dim strLocalN   As String
    Dim strPath     As String
   
    strLocalN = "Mi_Tabla_Denormalizada"
    strPath = CurrentProject.Path & "\"
   
    w = PivotArray("Vendedor", "Mi_Tabla", 2, "Ciudad", "Importe_Ventas")
   
    ArrayToExcel w, strPath, strLocalN
   
    DoCmd.TransferSpreadsheet acImport, , _
                    strLocalN, strPath & strLocalN & ".xlsx", True
   
    Kill strPath & strLocalN & ".xlsx"
End Sub

Función que Denormaliza

'---------------------------------------------------------------------------------------------------------------------------------------
' Nombre:       PivotArray
' Propósito:    Crea una matriz 2D, organizando en varias columnas datos de una sola columna normalizada.
' Descripción:  CampoQueAgrupa:     Campo sobre el que se va a agrupar.
'               NombreTabla:        Tabla que contiene los datos.
'               NoGrupos:           Número de grupos de columnas
'               NombresCampos:      Nombres de los campos que se van a repartir en columnas,
'                                   cada campo entre comillas y separado por comas.
'
' Author:       Diego F.Pereira-Perdomo
'
' Date:         May-22-2013
' Modificada:   May-23-2013 para añadir ParamArray según recomendación de José Bengoechea Ibaceta
'---------------------------------------------------------------------------------------------------------------------------------------
Public Function PivotArray(CampoQueAgrupa As String, _
                              NombreTabla As String, _
                                 NoGrupos As Integer, _
               ParamArray NombresCampos() As Variant) As Variant()

    Dim dbs         As DAO.Database
    Dim strSQL1     As String
    Dim rst1        As DAO.Recordset
    Dim strSQL2     As String
    Dim rst2        As DAO.Recordset
    Dim w
    Dim i           As Integer
    Dim j           As Integer
    Dim contadorA   As Long
    Dim contadorC   As Integer
    Dim k           As Integer
    Dim l           As Integer
    Dim campos
    Dim m           As Integer
    Dim n           As Integer
   
    Set dbs = CurrentDb
    strSQL1 = "SELECT DISTINCT " & CampoQueAgrupa & _
            " FROM " & NombreTabla
    Set rst1 = dbs.OpenRecordset(strSQL1)
    With rst1
        If Not .EOF And Not .BOF Then
            .MoveLast
            i = .RecordCount
            j = UBound(NombresCampos) + 1
            k = j * NoGrupos
            .MoveFirst
            ReDim w(i, k)
            w(.AbsolutePosition, 0) = CampoQueAgrupa
            contadorA = 1
            For m = 1 To NoGrupos
                For n = 0 To UBound(NombresCampos)
                    w(.AbsolutePosition, contadorA) = Trim(NombresCampos(n)) & m
                    contadorA = contadorA + 1
                Next n
            Next m
            Do Until .EOF
                w(.AbsolutePosition + 1, 0) = .Fields(0)
                strSQL2 = "SELECT "
                For n = 0 To UBound(NombresCampos)
                    strSQL2 = strSQL2 & NombresCampos(n)
                    If Not n = UBound(NombresCampos) Then
                        strSQL2 = strSQL2 & ", "
                    End If
                Next n
                strSQL2 = strSQL2 & " FROM " & NombreTabla & _
                                    " WHERE " & CampoQueAgrupa & " = " & .Fields(0)
                Set rst2 = dbs.OpenRecordset(strSQL2)
                With rst2
                    If Not .EOF And Not .BOF Then
                        contadorA = 1
                        Do Until .EOF
                            contadorC = 0
                            For l = (j * contadorA) - (j - 1) To (j * contadorA)
                                If l <= k Then
                                    w(rst1.AbsolutePosition + 1, l) = .Fields(contadorC)
                                    contadorC = contadorC + 1
                                End If
                            Next l
                            .MoveNext
                            contadorA = contadorA + 1
                        Loop
                    End If
                End With
                .MoveNext
            Loop
        End If
    End With
    PivotArray = w
End Function

Función necesaria para exportar el array a Excel

'---------------------------------------------------------------------------------------------------------------------------------------
' Nombre:       ArrayToExcel
' Propósito:    Exporta una matriz 2D a Excel.
' Descripción:  w:            El nombre del array.
'               strPath:      Ruta.
'               strFile:      Nombre del archivo.
'
' Author:       Diego F.Pereira-Perdomo
'
' Date:         Jul-11-2012
'---------------------------------------------------------------------------------------------------------------------------------------
Public Function ArrayToExcel(w() As Variant, _
                          strPath As String, _
                          strFile As String)

On Error GoTo ErrorHandler

    Dim xlApp   As Object
    Dim xlWb    As Object
    Dim xlWs    As Object

    Set xlApp = CreateObject("Excel.Application")
    Set xlWb = xlApp.Workbooks.Add
    Set xlWs = xlWb.Worksheets("Sheet1")

    With xlWb
        xlWs.cells(1, 1).Resize(UBound(w, 1) + 1, UBound(w, 2) + 1).Value = w
    End With

    DoEvents
    xlWb.SaveAs (strPath & strFile)
    xlWb.Close
    xlApp.Quit
  
  
ExitFunction:

    If Not xlApp Is Nothing Then
       xlApp.Quit
    End If
   
    Set xlWs = Nothing
    Set xlWb = Nothing
    Set xlApp = Nothing
   
    Exit Function

ErrorHandler:
    Select Case Err.Number
       Case 0
       Case Else
           MsgBox Err.Number & ": " & Err.Description
           Resume ExitFunction
    End Select
End Function

"To VBA or not to VBA... that's the question" DFP
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable