Visual Basic para Aplicaciones - Ordenar y Eliminar filas sin color

Life is soft - evento anual de software empresarial
   
Vista:

Ordenar y Eliminar filas sin color

Publicado por javier newmelvin@hotmail.com (25 intervenciones) el 18/11/2017 00:31:24
Buenas Tardes

Espero puedan apoyarme con algo que seguramente es muy fácil para alguien con mucha experiencia ...

necesito subir la información de unas celdas hacia la fila de color en forma horizontal
y después eliminar esas filas (donde estaba la información)
espero haberme explicado

envío un archivo en la hoja 1 es como tengo mi información
en la hoja 2 es como debería quedar cuando se ejecute la macro

Cabe mencionar que mi archivo aveces contiene hasta la fila 500 000
El espacio(Num de filas) entre filas de color es variado

muchas gracias por su tan valiosa
ayuda
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

Ordenar y Eliminar filas sin color

Publicado por JuanC juanc2942@gmail.com (552 intervenciones) el 18/11/2017 10:59:59
no creo que sea necesario una macro, con aplicar Autofiltro y Copiar y Pegar ya es suficiente...
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

Ordenar y Eliminar filas sin color

Publicado por javier (25 intervenciones) el 21/11/2017 16:33:07
Buen dia,Agradezco tu tan valiosa respuesta
lo que tu creas es respetable sin embargo
para mi es necesario una macro ya que de ser asi tendria que copiar fila por fila e ir eliminando lo que voy copiando

cuando sean "pocos" registros esta bien
pero mis registros son hasta 500 000 o mas

es por eso que me atrevi a pedir alguna ayuda al foro para desarrollar un macro,
espero alguien me pueda apoyar

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

Ordenar y Eliminar filas sin color

Publicado por JuanC juanc2942@gmail.com (552 intervenciones) el 21/11/2017 18:56:27
ok, con esta ayuda -o retocando un poco- debería funcionar...
(NO lo probé con miles de datos)

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
39
40
41
42
43
44
45
46
47
48
49
Option Explicit
 
Sub test()
Dim rng As Range, cell As Range, rng2 As Range
Dim i%
On Error Resume Next
With Application
     .DisplayAlerts = False
     .ScreenUpdating = False
     .EnableEvents = False
     .Calculation = xlCalculationManual
End With
 
Set rng = Range("A1").CurrentRegion.Resize(, 1)
Set rng2 = rng
Set rng = rng.SpecialCells(xlCellTypeConstants)
 
For Each cell In rng
    For i = 4 To 8
        cell.Offset(0, i).Value = cell.Offset(1, i).Value
    Next
Next
 
Set rng2 = getrng(rng, rng2)
rng2.EntireRow.Delete
Range("A1").Select
 
With Application
     .DisplayAlerts = True
     .ScreenUpdating = True
     .EnableEvents = True
     .Calculation = xlCalculationAutomatic
End With
 
End Sub
 
Function getrng(ByVal r1 As Range, ByVal r2 As Range) As Range
Dim ret$
On Error Resume Next
ret = ActiveSheet.Name
Worksheets.Add.Name = "_tmp_"
Range(r1.Address).Value = 1
Range(r2.Address).Value = 1
Intersect(Range(r1.Address), Range(r2.Address)).Clear
Sheets(ret).Select (False)
Cells.SpecialCells(xlCellTypeConstants).Select
Worksheets("_tmp_").Delete
Set getrng = Selection
End Function
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

Ordenar y Eliminar filas sin color

Publicado por javier (25 intervenciones) el 21/11/2017 19:57:12
que genial

Ya casi...

mira al ejecutar la macro las filas 3,4,5, / 8,9,10 /13, 14, 15, 16 No estan desaparecen esta bien pero deben estar ( es decir al información debe ir "poniendose" al final de de la ultima columna ..de AZUL)

en ejemplo que envio en la hoja 2 es como debería quedar

Muchas gracias

saludos
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

Ordenar y Eliminar filas sin color

Publicado por JuanC juanc2942@gmail.com (552 intervenciones) el 21/11/2017 21:45:16
perdón, no había visto todos los datos (pensé que sólo subía una fila)
va de nuevo modificado...

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
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Option Explicit
 
Sub test()
Dim rng As Range, cell As Range, rng2 As Range
Dim i&, y&, c&
On Error Resume Next
With Application
     .DisplayAlerts = False
     .ScreenUpdating = False
     .EnableEvents = False
     .Calculation = xlCalculationManual
End With
 
Set rng = Range("A1").CurrentRegion.Resize(, 1)
Set rng2 = rng
Set rng = rng.SpecialCells(xlCellTypeConstants)
 
For Each cell In rng
    y = 1
    c = 4
    Do While 1
       With cell
            If .Offset(y, 0).Interior.ColorIndex <> xlColorIndexNone Or VBA.Trim(.Offset(y, 4).Value) = "" Then Exit Do
            For i = 4 To 8
                .Offset(0, c).Value = .Offset(y, i).Value
                c = c + 1
            Next
            y = y + 1
       End With
    Loop
Next
 
Set rng2 = getrng(rng, rng2)
rng2.EntireRow.Delete
Range("A1").Select
 
With Application
     .DisplayAlerts = True
     .ScreenUpdating = True
     .EnableEvents = True
     .Calculation = xlCalculationAutomatic
End With
 
End Sub
 
Function getrng(ByVal r1 As Range, ByVal r2 As Range) As Range
Dim ret$
On Error Resume Next
ret = ActiveSheet.Name
Worksheets.Add.Name = "_tmp_"
Range(r1.Address).Value = 1
Range(r2.Address).Value = 1
Intersect(Range(r1.Address), Range(r2.Address)).Clear
Sheets(ret).Select (False)
Cells.SpecialCells(xlCellTypeConstants).Select
Worksheets("_tmp_").Delete
Set getrng = Selection
End Function
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

Ordenar y Eliminar filas sin color

Publicado por javier (25 intervenciones) el 22/11/2017 17:17:01
Hola
Otra vez disculpa nuevamente

mira sucede algo curioso

lo que me envías esta perfecto exacto así es como lo necesito------

solo que pasa algo ////// al copiar mas datos se borran todos .......



envio un archivo con datos si se observa en el ejemplo con esos datos la macro que me envías esta perfecta

PERO si se agregan mas filas se borra todo... intenta copiar unas 20 0 30 filas mas de los mismos datos que te envio hacia abajo y veras de lo que hablo

muchas gracias por tu tan valiosa ayuda

saludos
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

Ordenar y Eliminar filas sin color

Publicado por JuanC juanc2942@gmail.com (552 intervenciones) el 22/11/2017 19:31:23
el problema no es el código, el problema es que los datos aparecen de otra manera,
para ser más exacto, las celdas de las columnas E hasta I no aparacen pintadas como sí
lo estaban en el otro archivo (se debe pintar toda la fila o modificar el código, todo tuyo...)
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

Ordenar y Eliminar filas sin color

Publicado por javier (25 intervenciones) el 22/11/2017 19:36:27
hola
Mil gracias por tu atencion

mira ya pinte las columnas como dices de la E hasta la I (como en el otro archivo) pero el problema es el mismo
ejecuta la como lo envío y si funciona bien
pero si agrego es decir copio y pego unas 20 filas mas
se borra todo te envío el archivo

y una vez mas 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

Ordenar y Eliminar filas sin color

Publicado por JuanC juanc2942@gmail.com (552 intervenciones) el 22/11/2017 20:10:57
ok, depuré el código y ya encontré el problema (también tengo la solución
pero hay que hacer casi todo de otra manera)
en la línea
Range(r1.Address).Value = 1
se produce error por la cantidad de direcciones de celda que recibe, lo mismo pasa
con la función Intersect

solución: trabajar con colecciones o un bucle que recorra todos los datos
desde abajo hacia arriba y vaya copiando y eliminando...
si llego a tener tiempo y ganas otro día te lo hago...
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

Ordenar y Eliminar filas sin color

Publicado por javier (25 intervenciones) el 22/11/2017 20:49:12
Hola

definitivo mil gracias

quedare en espera gracias por tu ayuda
feliz dia
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

Ordenar y Eliminar filas sin color

Publicado por JuanC juanc2942@gmail.com (552 intervenciones) el 24/11/2017 10:42:20
veamos que pasa ahora...


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
39
40
41
42
43
44
45
46
47
48
Option Explicit
 
Sub test()
Dim rng As Range, cell As Range
Dim i&, y&, c&
Dim col As New Collection
On Error Resume Next
With Application
     .DisplayAlerts = False
     .ScreenUpdating = False
     .EnableEvents = False
     .Calculation = xlCalculationManual
End With
 
Set rng = Range("A1").CurrentRegion.Resize(, 1)
Set rng = rng.SpecialCells(xlCellTypeConstants)
 
For Each cell In rng
    y = 1
    c = 4
    Do While 1
       With cell
            If .Offset(y, 0).Interior.ColorIndex <> xlColorIndexNone Or VBA.Trim(.Offset(y, 4).Value) = "" Then Exit Do
            col.Add .Offset(y, 0).Address(0, 0)
            For i = 4 To 8
                .Offset(0, c).Value = .Offset(y, i).Value
                c = c + 1
            Next
            y = y + 1
       End With
    Loop
Next
 
c = col.Count
For i = c To 1 Step -1
    Range(col.Item(i)).EntireRow.Delete
Next
 
Range("A1").Select
 
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

Ordenar y Eliminar filas sin color

Publicado por javier (25 intervenciones) el 25/11/2017 00:44:18
Lo q paso es q funciono a la perfección realmente sorprendido mas que 10

como es que saben tanto me pregunto ...
me encantaria saber la mitad de lo q sabes...

bueno mil gracias por tu ayuda
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

Ordenar y Eliminar filas sin color

Publicado por javier (25 intervenciones) el 27/11/2017 18:39:25
Hola

en verdad me d a mucha pena
pero debo comentar....

funciona a al perfeccion
pero solo cuando son menos de 10 000 registros

pero cuando son mas de 300 000 filas ya ... no funciona se tarda horas en procesar
me podrias apoyar ay en esete ultimo detallito???

que sea optima para contenido de mas de 500 000 filas

Mil gracias por tu ayuda
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

Ordenar y Eliminar filas sin color

Publicado por JuanC juanc2942@gmail.com (552 intervenciones) el 27/11/2017 22:24:50
dudo que semejante cantidad de datos pueda procesarse 'rápido'
se me ocurren 2 cosas: trabajar con matrices en lugar de for each o hacer una aplicación
externa a excel (un ejecutable .exe)
si me envias el archivo completo puedo intentarlo, de otra manera, ni lo intento...
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

Ordenar y Eliminar filas sin color

Publicado por javier (25 intervenciones) el 27/11/2017 23:01:30
Hola
de verdad gracias por tu atención
y envío el archivo

ahora bien lo mas seguro es que descartaríamos una aplicación externa un ejecutable...

muchas gracias espero se pueda hacer algo

saludos
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

Ordenar y Eliminar filas sin color

Publicado por JuanC juanc2942@gmail.com (552 intervenciones) el 28/11/2017 15:32:42
tal y como está me tarda +/-22min (VBA/Excel) y +/-1seg con un ejecutable pero como esta opción
está descartada, doy por cerrado el tema
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