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.

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.

Consultoría Excel / Cursos de Excel

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

Facebook, Twitter, Youtube y Google+