Formulario de contacto

Nombre

Correo electrónico *

Mensaje *

martes, 17 de abril de 2018

Cómo eliminar columnas cada X columnas usando VBA

Hola queridos lectores.

Hace poco un lector me hizo una pregunta la cual quería compartir con todos vosotros:

Su problema era el siguiente. 

Cada més se tiene que descargar un informe de otro software y prepararlo para poder trabajar con él en Excel. Este informe trae muchos datos innecesarios y se requiere eliminar columnas para su adaptación. El hecho es que los datos innecesarios siempre vienen en la misma secuencia. Cada 4 columnas viene una columna a mantenerse, y hay muchas columnas. La adaptación manual requiere mucho control (no eliminar columnas incorrectas) asi como tiempo.




Es decir que una vez eliminadas esas columnas el resultado sería así:



Con una simple macro, este proceso se podría hacer en segundos.

Cómo?




Veamos el código VBA en si.

Sub EliminarColumnasConSaltoCadaXColumnas()
Dim ColsElim() As Integer 'esto es para definir la Matriz de columnas a eliminar
Dim Col As Integer
Dim Ppio As Integer, Fin As Integer
Dim Salto As Variant

'Primero preguntamos al usuario por el rango de columnas...
Set Rango = Application.InputBox("Por favor indica el rango de análisis", "Rango a seleccionar", Selection.Address, , , , Type:=8)

'También preguntamos cada cuántas columnas deseamos saltar (por ejemplo, si se indica 4, se eliminará las columnas de 1-4, de 6-9 etc)

Salto = 0

Salto1:
Salto = InputBox("Por favor indica cada cuántas columnas saltamos, por ejemplo, si se indica 6 se eliminarán las columnas 1-6, 8-13, etc", "Salto")

    If Not IsNumeric(Salto) Then GoTo Salto1  'por si acaso se introduce un valor no numérico
 
Salto = CInt(Salto)  'convertimos salto a integer

'lo siguiente es identificar el número de columna del principio y del final de la matriz
Ppio = Rango.Item(1).Column
Fin = Rango.Columns.Count + Ppio - 1

'redimensionamos el tamaño de la matriz
ReDim ColsElim(1 To Fin - Ppio + 1) As Integer

'se pasa a identificar los números de columna que necesitan ser eliminados
    x = 0
    For i = Ppio To Fin Step 1
    x = x + 1
        If (x Mod (Salto + 1)) <> 0 Then
            ColsElim(x) = i
        End If
    Next i

'recorremos los valores de la matriz de derecha a izquierda para ir eliminandolos
    For Col = Fin - Ppio + 1 To 1 Step -1
            On Error Resume Next
            ActiveSheet.Columns(ColsElim(Col)).Delete Shift:=xlShiftToLeft
            On Error GoTo 0
    Next Col


End Sub



Pues ya está!

Espero que está macro le sea de utilidad a mucha gente
Saludos.



Te ha gustado el artículo?

No te olvides de mostrar tu gratitud hacia el autor (yo) mediante una de las 2 siguientes acciones:

1. Puedes dejar una donación pinchando en la siguiente imagen.

PayPal. La forma rápida y segura de pagar en Internet


2. Puedes recomendar el artículo en Google haciendo clic en g+1 (justo después del artículo), también puedes compartirlo en Facebook, y/o dejar comentarios.

Quieres aprender más en Excel o tienes algún problema que necesita solución?

Puedo ofrecer servicios de consultoría así como cursos personalizados online. Mírate el siguiente enlace si estás interesado/a.



El Sabio de Excel busca colaborades del blog

Si te interesa compartir tu conocimiento sobre Excel de tal manera que puedas ayudar a otras personas, por favor mándame un email a elsabiodeexcel@gmail.com


Subscríbete y recibe todos las entradas por email


Para ello regístrate suministrando tu email en el sitio "Recibe los trucos en tu email" del menú de la derecha.

O sígueme por las redes sociales


No hay comentarios:

Publicar un comentario