Excel - Macro Borrado de lineas que no cumplan

 
Vista:
sin imagen de perfil
Val: 4
Ha disminuido su posición en 2 puestos en Excel (en relación al último mes)
Gráfica de Excel

Macro Borrado de lineas que no cumplan

Publicado por Carlos (2 intervenciones) el 27/04/2017 18:04:03
Buenos días:

Necesito ayuda con una macro que me permita borrar FILAS que tenga la parte fila superior e inferior en blanco.


Captura

Como muestro en la imagen, tengo filas de 2 y tengo filas de 1, quisiera solo dejar las filas de 2 y quede 2 espacios en blanco entre ellas.

Espero me puedan ayudar
Carlos

(Adjunto Excel comprimido).
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Antoni Masana
Val: 3.334
Plata
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

Macro Borrado de lineas que no cumplan

Publicado por Antoni Masana (1070 intervenciones) el 28/04/2017 16:41:35
Falta el fichero.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil
Val: 4
Ha disminuido su posición en 2 puestos en Excel (en relación al último mes)
Gráfica de Excel

Macro Borrado de lineas que no cumplan

Publicado por Carlos (2 intervenciones) el 02/05/2017 16:10:12
Adjunto.

Gracias
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
Imágen de perfil de Antoni Masana
Val: 3.334
Plata
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

Macro Borrado de lineas que no cumplan

Publicado por Antoni Masana (1070 intervenciones) el 03/05/2017 08:46:35
La Macro

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Sub Borrar()
    Dim Linea As Long, Blancos As Byte, a As Byte, Num As Byte
 
    Linea = 1
    Do While True
       If Cells(Linea, 1) = "" Then
 
          ' --- Si debajo tiene 10 lineas en blanco finaliza
 
          Num = 0
          For a = Linea + 1 To Linea + 10
              If Cells(a, 1) = "" Then Num = Num + 1
          Next
          If Num = 10 Then Exit Do
 
          ' --- Si la Anterior y posterior estan vacias la borro
 
          If Cells(Linea - 1, 1) = "" And Cells(Linea + 1, 1) = "" Then
             Rows(Linea & ":" & Linea).Select
             Selection.Delete Shift:=xlUp
             Linea = Linea - 1
          End If
       End If
       Linea = Linea + 1
    Loop
End Sub

Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
1
Comentar
Revisar política de publicidad