Excel - ayuda con ciclo infinito

   
Vista:

ayuda con ciclo infinito

Publicado por vita (1 intervención) el 16/08/2017 03:29:46
Buenas noches
necesito eliminar las celdas en blanco de una columna de datos e hice este programa:

1
2
3
4
5
6
7
8
9
10
Range("g1").Select
Do While ActiveCell <> ""
Do While ActiveCell <> ""
ActiveCell.Offset(1, 0).Activate
Loop
Do While ActiveCell = ""
ActiveCell.Select
Selection.Delete xlUp
Loop
Loop

pero al terminar los datos continua eliminando celdas en blanco infinitamente
¿en que me estoy equivocando?
De antemano gracias por su tiempo :)
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

ayuda con ciclo infinito

Publicado por JuanC juanc2942@gmail.com (1228 intervenciones) el 17/08/2017 00:44:44
creo que no vale la pena 'arreglar' ese código, te hice algo, espero te sirva...

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
27
28
29
30
31
32
33
34
35
36
37
38
Option Explicit
 
'//By JuanC - Ago. 2017
 
Sub borrar_celdas_vacias()
Dim rng As Range, c As Range
Dim ws As Worksheet, aws As Worksheet
Dim v As Variant, i&, n&, sCol$
On Error Resume Next
sCol = "G"
With Application
     .DisplayAlerts = False
     .ScreenUpdating = False
     .EnableEvents = False
      .Calculation = xlCalculationManual
End With
Set aws = ActiveSheet
Set rng = aws.Range(sCol & "1", Range(sCol & Cells.Rows.Count).End(xlUp))
v = rng.Value
Set ws = Worksheets.Add
n = UBound(v)
For i = 1 To n
    If v(i, 1) = "" Then ws.Range(sCol & "1").Offset(i - 1).Value = 1
Next
Set rng = Nothing
Set rng = ws.Range(sCol & ":" & sCol).SpecialCells(xlCellTypeConstants)
If Not rng Is Nothing Then rng.Select
aws.Select 0
ws.Delete
If Not rng Is Nothing Then Selection.Delete xlShiftUp
aws.Range("A1").Activate
With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With
End Sub
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
Revisar política de publicidad