KEMBAR78
Macro | PDF | Teaching Mathematics | Computing And Information Technology
Scribd
Upload
21 views2 pages

Macro

The document contains a VBA script that defines two subroutines: Eliminar_Espacios and Consolidar_Columnas. Eliminar_Espacios removes empty rows and columns from a specified worksheet and calls Consolidar_Columnas to consolidate data. Consolidar_Columnas concatenates data from specified ranges into a single column while clearing any remaining data in the original columns.

Uploaded by

Yosselyn Nomberto
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
21 views2 pages

Macro

The document contains a VBA script that defines two subroutines: Eliminar_Espacios and Consolidar_Columnas. Eliminar_Espacios removes empty rows and columns from a specified worksheet and calls Consolidar_Columnas to consolidate data. Consolidar_Columnas concatenates data from specified ranges into a single column while clearing any remaining data in the original columns.

Uploaded by

Yosselyn Nomberto
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
You are on page 1/ 2

Option Explicit

Sub Eliminar_Espacios()

Dim fila As Long


Dim columna As Long
Dim ws As Worksheet
Dim rangotabla As Range
Dim rng_fila As Range
Dim i As Long

Set ws = ActiveWorkbook.Worksheets("Summary")

'Primera Fila Usada


fila = ws.Cells.Find(What:="*", After:=Cells(1, 1), _
SearchOrder:=xlRows, SearchDirection:=xlNext).Row

'Primera Columna Usada


columna = ws.Cells.Find(What:="*", After:=Cells(1, 1), _
SearchOrder:=xlColumns, SearchDirection:=xlNext).Column

'Borramos filas y columnas vacias


'FILAS
'IMPORTANTE: Si la data no tiene encabezado, va a borrar la primera observacion
Range("A1", Range("A" & fila)).EntireRow.Delete

'COLUMNAS, Borrar las columna que no contengan coordenadas


Set rangotabla = Range("A1").CurrentRegion
rangotabla.Columns(1).ClearContents
rangotabla.Columns("B:C").Delete

'Llamo a la macro que consolida


Call Consolidar_Columnas

End Sub

Sub Consolidar_Columnas()

Dim rango_unido As Range 'rango cuyas celda contienen la data concatenada


Dim rango_datos As Range 'rango cuyas filas contienen la data a ser concatenada
Dim celda As Range
Dim celda2 As Range
Dim fila As Long
Dim valor As String
Dim i As Long
Dim j As Long

'Ultima Fila Usada


fila = ActiveSheet.Cells.Find(What:="*", After:=Cells(1, 1), _
SearchOrder:=xlRows, SearchDirection:=xlPrevious).Row

'Establezaco el rango donde juntare los datos


Set rango_unido = Range("A1", Cells(fila, 1))
rango_unido.Select

For i = 1 To rango_unido.Rows.Count
Set rango_datos = Range(rango_unido.Cells(i, 1).Offset(0, 1),
rango_unido.Cells(i, 1).Offset(0, 3))
For Each celda In rango_datos
valor = valor & ";" & celda
Next celda

j = j + 1
Cells(j, 1).Value = Mid(valor, 2)
valor = ""

Set rango_datos = Range(rango_unido.Cells(i, 1).Offset(0, 4),


rango_unido.Cells(i, 1).Offset(0, 6))
For Each celda In rango_datos
valor = valor & ";" & celda
Next celda
j = j + 1
Cells(j, 1).Value = Mid(valor, 2)
valor = ""
Next i

'Eliminar Data sobrante


Range("B1", Range("B1").End(xlToRight).End(xlDown)).ClearContents

End Sub

You might also like