none
Repartir Filas Excel RRS feed

  • Pregunta

  • Estimados saludos y espero estén bien,

    Tengo la siguiente tabla en Excel

    lo que quisiera es saber una forma para tener el siguiente resultado con formula o programación visual:

    Son 82 filas las que tengo que realizar lo hago a mano y es tedioso, ya lo he intentado con tablas dinámicas pero igual hay que editar, si alguien supiera una forma de hacerlo por medio de formulas o la programación en visual, seria genial. De antemano gracias.

    Pdta. No soy programador pero tengo conocimientos básicos de Visual Net.

    miércoles, 17 de junio de 2020 9:00

Respuestas

  • Hola:
    En el siguiente ejemplo se hace uso de una libreria OpenXml llamado Spire.Xls, asi que tendras que añadir una referencia a dicha libreria

    En un Form con 2 DataGridView y 2 Button, copia y pega el siguiente codigo

    Option Explicit On
    Option Strict On
    Imports System.Data.OleDb
    Imports Spire.Xls
    Public Class Form5
        Private mdtDestino As New DataTable
        Private Sub Form5_Load(sender As Object, e As EventArgs) Handles Me.Load
            Me.Cursor = Cursors.WaitCursor
            btnCargar.Enabled = True
            btnCrear.Enabled = False
            DataGridView1.AllowUserToAddRows = False
            DataGridView2.AllowUserToAddRows = False
            'Crear las columnas del datatable
            mdtDestino.Columns.Add(New DataColumn("Nombre", Type.GetType("System.String")))
            mdtDestino.Columns.Add(New DataColumn("Concepto", Type.GetType("System.String")))
            mdtDestino.Columns.Add(New DataColumn("Datos", Type.GetType("System.String")))
            MostrarHoja(Application.StartupPath & "\Libro1.xlsx", "Hoja1", Me.DataGridView1)
            Me.WindowState = FormWindowState.Maximized
        End Sub
        Private Sub MostrarHoja(archivoExcelOrigen As String, hojaOrigen As String, DataGridView As DataGridView)
            Me.Cursor = Cursors.WaitCursor
            Dim lsCadConexionExcel As String = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & archivoExcelOrigen & ";Extended Properties='Excel 12.0 Xml;IMEX=1;HDR=Yes'"
            Dim loDataTable As New DataTable("ORIGEN")
            Try
                Using loConexion As New OleDbConnection(lsCadConexionExcel)
                    Dim lsQuery As String = "Select * From [" & hojaOrigen & "$]"
                    Dim loDataAdapter As New OleDbDataAdapter(lsQuery, loConexion)
                    'Cargar el Datatable con el fichero XLS
                    loDataAdapter.Fill(loDataTable)
                End Using
                DataGridView1.DataSource = loDataTable
                Me.Cursor = Cursors.Default
            Catch ex As Exception
                Me.Cursor = Cursors.Default
                MessageBox.Show(ex.Message, "", MessageBoxButtons.OK, MessageBoxIcon.Information)
            End Try
        End Sub
        Private Sub btnCargar_Click(sender As Object, e As EventArgs) Handles btnCargar.Click
            btnCargar.Enabled = False
            btnCrear.Enabled = True
            Dim ldtDataTable As DataTable = CType(DataGridView1.DataSource, DataTable)
            'Cargar los nombres de las columnas del datatable
            Dim ListaColumnas(4) As String
            For liCiclo As Integer = 0 To ldtDataTable.Columns.Count - 1
                ListaColumnas(liCiclo) = ldtDataTable.Columns(liCiclo).ColumnName
            Next
            Dim FilaDestino As DataRow
            For Each Fila As DataRow In ldtDataTable.Rows
                For liCiclo As Integer = 1 To ldtDataTable.Columns.Count - 1
                    FilaDestino = mdtDestino.NewRow
                    FilaDestino.Item("Nombre") = Fila.Item("Nombres")
                    FilaDestino.Item("Concepto") = ListaColumnas(liCiclo)
                    Select Case liCiclo
                        Case 1
                            FilaDestino.Item("Datos") = Fila.Item("edad")
                        Case 2
                            FilaDestino.Item("Datos") = Fila.Item("Genero")
                        Case 3
                            FilaDestino.Item("Datos") = Fila.Item("area")
                        Case 4
                            FilaDestino.Item("Datos") = Fila.Item("cargo")
                    End Select
                    mdtDestino.Rows.Add(FilaDestino)
                Next
            Next
            DataGridView2.DataSource = mdtDestino
        End Sub

        Private Sub btnCrear_Click(sender As Object, e As EventArgs) Handles btnCrear.Click
            Dim workbook As Workbook = New Workbook()
            'Inicializar hoja de cálculo
            Dim sheet As Worksheet = workbook.Worksheets(0)
            sheet.InsertDataTable(mdtDestino, True, 1, 1, -1, -1)
            '
            'Establece el estilo del cuerpo
            Dim oddStyle As CellStyle = workbook.Styles.Add("oddStyle")
            oddStyle.Borders(BordersLineType.EdgeLeft).LineStyle = LineStyleType.Thin
            oddStyle.Borders(BordersLineType.EdgeRight).LineStyle = LineStyleType.Thin
            oddStyle.Borders(BordersLineType.EdgeTop).LineStyle = LineStyleType.Thin
            oddStyle.Borders(BordersLineType.EdgeBottom).LineStyle = LineStyleType.Thin
            oddStyle.KnownColor = ExcelColors.LightGreen1
            Dim evenStyle As CellStyle = workbook.Styles.Add("evenStyle")
            evenStyle.Borders(BordersLineType.EdgeLeft).LineStyle = LineStyleType.Thin
            evenStyle.Borders(BordersLineType.EdgeRight).LineStyle = LineStyleType.Thin
            evenStyle.Borders(BordersLineType.EdgeTop).LineStyle = LineStyleType.Thin
            evenStyle.Borders(BordersLineType.EdgeBottom).LineStyle = LineStyleType.Thin
            evenStyle.KnownColor = ExcelColors.LightTurquoise
            For Each range As CellRange In sheet.AllocatedRange.Rows
                If range.Row Mod 2 = 0 Then
                    range.CellStyleName = evenStyle.Name
                Else
                    range.CellStyleName = oddStyle.Name
                End If
            Next range
            'Establece el estilo del encabezado
            Dim styleHeader As CellStyle = sheet.Rows(0).Style
            styleHeader.Borders(BordersLineType.EdgeLeft).LineStyle = LineStyleType.Thin
            styleHeader.Borders(BordersLineType.EdgeRight).LineStyle = LineStyleType.Thin
            styleHeader.Borders(BordersLineType.EdgeTop).LineStyle = LineStyleType.Thin
            styleHeader.Borders(BordersLineType.EdgeBottom).LineStyle = LineStyleType.Thin
            styleHeader.VerticalAlignment = VerticalAlignType.Center
            styleHeader.KnownColor = ExcelColors.Green
            styleHeader.Font.KnownColor = ExcelColors.White
            styleHeader.Font.IsBold = True
            '
            workbook.SaveToFile(Application.StartupPath & "\Libro2.xlsx", ExcelVersion.Version2007)
            System.Diagnostics.Process.Start(Application.StartupPath & "\Libro2.xlsx")
        End Sub
    End Class

    Imagen Origen

    Imagen Destino


    Un saludo desde Bilbo
    Carlos
    • Marcado como respuesta eloshmt domingo, 5 de julio de 2020 12:54
    miércoles, 17 de junio de 2020 11:14

Todas las respuestas

  • Hola:
    En el siguiente ejemplo se hace uso de una libreria OpenXml llamado Spire.Xls, asi que tendras que añadir una referencia a dicha libreria

    En un Form con 2 DataGridView y 2 Button, copia y pega el siguiente codigo

    Option Explicit On
    Option Strict On
    Imports System.Data.OleDb
    Imports Spire.Xls
    Public Class Form5
        Private mdtDestino As New DataTable
        Private Sub Form5_Load(sender As Object, e As EventArgs) Handles Me.Load
            Me.Cursor = Cursors.WaitCursor
            btnCargar.Enabled = True
            btnCrear.Enabled = False
            DataGridView1.AllowUserToAddRows = False
            DataGridView2.AllowUserToAddRows = False
            'Crear las columnas del datatable
            mdtDestino.Columns.Add(New DataColumn("Nombre", Type.GetType("System.String")))
            mdtDestino.Columns.Add(New DataColumn("Concepto", Type.GetType("System.String")))
            mdtDestino.Columns.Add(New DataColumn("Datos", Type.GetType("System.String")))
            MostrarHoja(Application.StartupPath & "\Libro1.xlsx", "Hoja1", Me.DataGridView1)
            Me.WindowState = FormWindowState.Maximized
        End Sub
        Private Sub MostrarHoja(archivoExcelOrigen As String, hojaOrigen As String, DataGridView As DataGridView)
            Me.Cursor = Cursors.WaitCursor
            Dim lsCadConexionExcel As String = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & archivoExcelOrigen & ";Extended Properties='Excel 12.0 Xml;IMEX=1;HDR=Yes'"
            Dim loDataTable As New DataTable("ORIGEN")
            Try
                Using loConexion As New OleDbConnection(lsCadConexionExcel)
                    Dim lsQuery As String = "Select * From [" & hojaOrigen & "$]"
                    Dim loDataAdapter As New OleDbDataAdapter(lsQuery, loConexion)
                    'Cargar el Datatable con el fichero XLS
                    loDataAdapter.Fill(loDataTable)
                End Using
                DataGridView1.DataSource = loDataTable
                Me.Cursor = Cursors.Default
            Catch ex As Exception
                Me.Cursor = Cursors.Default
                MessageBox.Show(ex.Message, "", MessageBoxButtons.OK, MessageBoxIcon.Information)
            End Try
        End Sub
        Private Sub btnCargar_Click(sender As Object, e As EventArgs) Handles btnCargar.Click
            btnCargar.Enabled = False
            btnCrear.Enabled = True
            Dim ldtDataTable As DataTable = CType(DataGridView1.DataSource, DataTable)
            'Cargar los nombres de las columnas del datatable
            Dim ListaColumnas(4) As String
            For liCiclo As Integer = 0 To ldtDataTable.Columns.Count - 1
                ListaColumnas(liCiclo) = ldtDataTable.Columns(liCiclo).ColumnName
            Next
            Dim FilaDestino As DataRow
            For Each Fila As DataRow In ldtDataTable.Rows
                For liCiclo As Integer = 1 To ldtDataTable.Columns.Count - 1
                    FilaDestino = mdtDestino.NewRow
                    FilaDestino.Item("Nombre") = Fila.Item("Nombres")
                    FilaDestino.Item("Concepto") = ListaColumnas(liCiclo)
                    Select Case liCiclo
                        Case 1
                            FilaDestino.Item("Datos") = Fila.Item("edad")
                        Case 2
                            FilaDestino.Item("Datos") = Fila.Item("Genero")
                        Case 3
                            FilaDestino.Item("Datos") = Fila.Item("area")
                        Case 4
                            FilaDestino.Item("Datos") = Fila.Item("cargo")
                    End Select
                    mdtDestino.Rows.Add(FilaDestino)
                Next
            Next
            DataGridView2.DataSource = mdtDestino
        End Sub

        Private Sub btnCrear_Click(sender As Object, e As EventArgs) Handles btnCrear.Click
            Dim workbook As Workbook = New Workbook()
            'Inicializar hoja de cálculo
            Dim sheet As Worksheet = workbook.Worksheets(0)
            sheet.InsertDataTable(mdtDestino, True, 1, 1, -1, -1)
            '
            'Establece el estilo del cuerpo
            Dim oddStyle As CellStyle = workbook.Styles.Add("oddStyle")
            oddStyle.Borders(BordersLineType.EdgeLeft).LineStyle = LineStyleType.Thin
            oddStyle.Borders(BordersLineType.EdgeRight).LineStyle = LineStyleType.Thin
            oddStyle.Borders(BordersLineType.EdgeTop).LineStyle = LineStyleType.Thin
            oddStyle.Borders(BordersLineType.EdgeBottom).LineStyle = LineStyleType.Thin
            oddStyle.KnownColor = ExcelColors.LightGreen1
            Dim evenStyle As CellStyle = workbook.Styles.Add("evenStyle")
            evenStyle.Borders(BordersLineType.EdgeLeft).LineStyle = LineStyleType.Thin
            evenStyle.Borders(BordersLineType.EdgeRight).LineStyle = LineStyleType.Thin
            evenStyle.Borders(BordersLineType.EdgeTop).LineStyle = LineStyleType.Thin
            evenStyle.Borders(BordersLineType.EdgeBottom).LineStyle = LineStyleType.Thin
            evenStyle.KnownColor = ExcelColors.LightTurquoise
            For Each range As CellRange In sheet.AllocatedRange.Rows
                If range.Row Mod 2 = 0 Then
                    range.CellStyleName = evenStyle.Name
                Else
                    range.CellStyleName = oddStyle.Name
                End If
            Next range
            'Establece el estilo del encabezado
            Dim styleHeader As CellStyle = sheet.Rows(0).Style
            styleHeader.Borders(BordersLineType.EdgeLeft).LineStyle = LineStyleType.Thin
            styleHeader.Borders(BordersLineType.EdgeRight).LineStyle = LineStyleType.Thin
            styleHeader.Borders(BordersLineType.EdgeTop).LineStyle = LineStyleType.Thin
            styleHeader.Borders(BordersLineType.EdgeBottom).LineStyle = LineStyleType.Thin
            styleHeader.VerticalAlignment = VerticalAlignType.Center
            styleHeader.KnownColor = ExcelColors.Green
            styleHeader.Font.KnownColor = ExcelColors.White
            styleHeader.Font.IsBold = True
            '
            workbook.SaveToFile(Application.StartupPath & "\Libro2.xlsx", ExcelVersion.Version2007)
            System.Diagnostics.Process.Start(Application.StartupPath & "\Libro2.xlsx")
        End Sub
    End Class

    Imagen Origen

    Imagen Destino


    Un saludo desde Bilbo
    Carlos
    • Marcado como respuesta eloshmt domingo, 5 de julio de 2020 12:54
    miércoles, 17 de junio de 2020 11:14
  • Estimado, abri mi Visual Studio agregue 2 botones y 2 DataGridView  pero me salen demasiados errores.

    se que estoy haciendo algo mal ya que no domino ese nivel de programacion, si pudieras ser un poco mas especifico.

    jueves, 18 de junio de 2020 6:31
  • Hola:
    Al inicio del post escribi esto
    En el siguiente ejemplo se hace uso de una libreria OpenXml llamado Spire.Xls, asi que tendras que añadir una referencia a dicha libreria <

    Si NO haces esto, NO funcionara. Si añades dicha referencia, es solo copiar y pegar el codigo expuesto.

    Un saludo desde Bilbo
    Carlos
    jueves, 18 de junio de 2020 6:51
  • Hola:
    Si no quieres usar librerias OPenXml, revisa el siguiente enlace

    http://mvp-access.es/softjaen/vbnet/office/sjvbnetofc02.htm

    Un saludo desde Bilbo
    Carlos
    jueves, 18 de junio de 2020 7:06
  • Hola

    Teniendo en cuenta que no eres programador lo más sencillo es que lo hagas con formulas. Para ello vas a requerir usar columnas auxiliares en ambas tablas.

    (Te dejaría un instructivo con imágenes pero no se cómo verificar mi cuenta jajaja)

    1. En la tabla base, inserta una columna antes del campo Nombres, para este caso la voy a identificar como consecutivo. Rellena esa columna con un consecutivo, es decir: 1,2,3...

    2. En la tabla donde necesitas llevar los datos inserta también una columna antes del campo Nombres. La usaremos para saber que fila debemos traer de la tabla origen. En la segunda fila de esa columna usa la siguiente formula =REDONDEAR.MAS((FILA()-1)/4;0) y extiende la formula a las celdas hacia abajo. Utilizando esta formula lo que hace es que repita el consecutivo tantas veces como datos necesitamos traer, para el caso son 4, si necesitaras 5 entonces divides en 5.

    3. En la columna del Nombre del la tabla donde vamos a llevar los datos utiliza un BUSCARV para traer el nombre desde el origen, utilizando como valor buscado el consecutivo.

    4. Para traer los demás campos puedes utilizar las formulas anidadas INDICE y COINCIDIR. No tengo manera sencilla de explicarte sin imagenes, por lo tanto te recomiendo que si no sabes como usarlas busca tutoriales en internet. En caso que tengas OFFICE 365, es más fácil que uses BUSCARX.

    Espero te pueda servir de ayuda, perdona si no es lo suficientemente claro, si tienes dudas no dudes en preguntar.

    Saludos.

    lunes, 22 de junio de 2020 14:12
  • Gracias, no entendí lo de agregar la librería hasta que lo especificaste, no sabia que era ni como se asía, una vez averiguado solo fue copiar y pegar.
    domingo, 5 de julio de 2020 12:55
  • Gracias por tu aporte estimado, igualmente me funciono, por un tema de automatización e ir lo mejorando opte por el visual pero tu respuesta igualmente me enseña algo que no sabia.
    domingo, 5 de julio de 2020 12:58