Forums Últimos mensajes - Powered by IBM
 
Tags Palabras claves

Ayuda con este codigo.

12/10/2006 - 18:29 por Alejandro Garcia | Informe spam
Ayuda Hacer una pregunta
Este codigo lo puso KL como respuesta a una persona de este foro hace
unos días, yo habia puesto un post un tanto parecido y pense que podria
adecuarlo a mis necesidades pero no he podido, ¿alguien me podria
colaborar un poco?. Mi problema, eliminar fila de la hoja Activos
dependiendo de una condicion, que en la columna H tenga X, estos
registros deben pasar a otra hoja del mismo libro llamada Retirados,
esta nueva fila(en retirados) puede ir al final de la hoja(la hoja ya
existe). ¿Sera esto posible?, Gracias de antemano.

El codigo:
Sub Creating_New_Sheet()
Application.ScreenUpdating = False
Sheets(ActiveSheet.Name).Copy After:=ActiveSheet
With ActiveSheet.Range("H:H")
On Error Resume Next
Do
.Find _
(What:="A", _
After:=.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext).EntireRow.Delete
Loop Until Err.Number <> 0
End With
End Sub

Esta Macro lo que hace es crear una nueva hoja y pasar las filas que
tengan X a esa nueva hoja, yo ya tengo creada la hoja y lo que deseo es
anexar dichas filas al final de esa hoja.
email Siga el debateRespuesta 9 respuestasRespuesta Tengo una respuesta

Preguntas similare

Mostrar todos los temas similares

Leer las respuestas

#6 J.P.
17/10/2006 - 16:37 | Informe spam
Buen día
Les cuento, disculpen soy muy principiante y cometo errores, que luego
me doy cuenta.
Puedes probar con este codigo, el anterior tenia un error y era que
solo cortaba la primera columna, pues de ahi en adelante ya estaba
ubicado en la hoja retirados.

Sub EliminarRetirados()
Dim celda As Range
Dim c() As Integer
Dim i As Integer
Dim j As Integer
Sheets("Activos").Select
'En esta parte defino cuantas columnas son las que hay que cortar
For Each celda In Range("H:H")
If celda.Value = "X" Then
i = i + 1
End If
Next
'incluyo las columnas en un vector para luego cortarlas
'Es igual que al de arriba pero si quieren el anterior pueden oviarlo y
definir
'c() con algun indice, en la definición, este tiene que ser por lo
menos
'igual a las filas cortadas, por eso opto por realizar el paso anterior
ReDim c(i)
i = 0
For Each celda In Range("H:H")
If celda.Value = "X" Then
i = i + 1
c(i) = celda.Row
End If
Next
'Corto las columnas
For j = 1 To i
Sheets("Activos").Cells(c(j), 1).EntireRow.Cut
Sheets("Retirados").Select
Range("A65536").Select
Selection.End(xlUp).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Next
'borro las columnas
For j = i To 1 Step -1
Sheets("Activos").Cells(c(j), 1).EntireRow.Delete
Next
End Sub

Bueno si alguien sabe como puedo simplificar el codigo para hacer mas
rapida la ejecución, les agradeceria que me lo hicieran saber.

Espero les sirva.
Respuesta Responder a este mensaje
#7 Gavillas
19/10/2006 - 20:19 | Informe spam
Gracias J.P. ahora si que funciona.
Ademas, tus comentarios por partes son muy instructivos.

Un saludo, Gavillas.

"J.P." escribió en el mensaje
news:
Buen día
Les cuento, disculpen soy muy principiante y cometo errores, que luego
me doy cuenta.
Puedes probar con este codigo, el anterior tenia un error y era que
solo cortaba la primera columna, pues de ahi en adelante ya estaba
ubicado en la hoja retirados.

Sub EliminarRetirados()
Dim celda As Range
Dim c() As Integer
Dim i As Integer
Dim j As Integer
Sheets("Activos").Select
'En esta parte defino cuantas columnas son las que hay que cortar
For Each celda In Range("H:H")
If celda.Value = "X" Then
i = i + 1
End If
Next
'incluyo las columnas en un vector para luego cortarlas
'Es igual que al de arriba pero si quieren el anterior pueden oviarlo y
definir
'c() con algun indice, en la definición, este tiene que ser por lo
menos
'igual a las filas cortadas, por eso opto por realizar el paso anterior
ReDim c(i)
i = 0
For Each celda In Range("H:H")
If celda.Value = "X" Then
i = i + 1
c(i) = celda.Row
End If
Next
'Corto las columnas
For j = 1 To i
Sheets("Activos").Cells(c(j), 1).EntireRow.Cut
Sheets("Retirados").Select
Range("A65536").Select
Selection.End(xlUp).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Next
'borro las columnas
For j = i To 1 Step -1
Sheets("Activos").Cells(c(j), 1).EntireRow.Delete
Next
End Sub

Bueno si alguien sabe como puedo simplificar el codigo para hacer mas
rapida la ejecución, les agradeceria que me lo hicieran saber.

Espero les sirva.
Respuesta Responder a este mensaje
#8 J.P.
31/10/2006 - 22:35 | Informe spam
Este codigo es más rapido en tiempo de ejecución que el anterior

Sub EliminarRetirados()

Dim celda As Range
Dim c() As Integer
Dim hoj As Worksheet
Dim i As Integer
Dim l As Integer

Set hoj = Worksheets("Activos")
Sheets("Activos").Select
Range("H65536").Select
i = Selection.End(xlUp).Row
Sheets("Activos").Cells(1, 1).Activate
ReDim c(i) As Integer
For Each celda In hoj.Range(Cells(1, 8), Cells(i, 8))
If celda.Value = "X" Or celda.Value = "x" Then
l = l + 1
c(l) = celda.Row
celda.EntireRow.Cut
Sheets("Retirados").Select
Range("A65536").Select
Selection.End(xlUp).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
Next

For i = l To 1 Step -1
hoj.Cells(c(i), 1).EntireRow.Delete
Next

Sheets("Retirados").Cells(1, 1).Activate

End Sub

El ciclo no se hace en toda la columna H sino hasta donde encuentre la
última X ó x


Gavillas ha escrito:

Gracias J.P. ahora si que funciona.
Ademas, tus comentarios por partes son muy instructivos.

Un saludo, Gavillas.

"J.P." escribió en el mensaje
news:
Buen día
Les cuento, disculpen soy muy principiante y cometo errores, que luego
me doy cuenta.
Puedes probar con este codigo, el anterior tenia un error y era que
solo cortaba la primera columna, pues de ahi en adelante ya estaba
ubicado en la hoja retirados.

Sub EliminarRetirados()
Dim celda As Range
Dim c() As Integer
Dim i As Integer
Dim j As Integer
Sheets("Activos").Select
'En esta parte defino cuantas columnas son las que hay que cortar
For Each celda In Range("H:H")
If celda.Value = "X" Then
i = i + 1
End If
Next
'incluyo las columnas en un vector para luego cortarlas
'Es igual que al de arriba pero si quieren el anterior pueden oviarlo y
definir
'c() con algun indice, en la definición, este tiene que ser por lo
menos
'igual a las filas cortadas, por eso opto por realizar el paso anterior
ReDim c(i)
i = 0
For Each celda In Range("H:H")
If celda.Value = "X" Then
i = i + 1
c(i) = celda.Row
End If
Next
'Corto las columnas
For j = 1 To i
Sheets("Activos").Cells(c(j), 1).EntireRow.Cut
Sheets("Retirados").Select
Range("A65536").Select
Selection.End(xlUp).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Next
'borro las columnas
For j = i To 1 Step -1
Sheets("Activos").Cells(c(j), 1).EntireRow.Delete
Next
End Sub

Bueno si alguien sabe como puedo simplificar el codigo para hacer mas
rapida la ejecución, les agradeceria que me lo hicieran saber.

Espero les sirva.
Respuesta Responder a este mensaje
#9 Alejandro Garcia
31/10/2006 - 22:46 | Informe spam
Efectivamente es muchisimo mas rapido que el otro. Gracias nuevamente
por todo.

Este codigo es más rapido en tiempo de ejecución que el anterior

Sub EliminarRetirados()

Dim celda As Range
Dim c() As Integer
Dim hoj As Worksheet
Dim i As Integer
Dim l As Integer

Set hoj = Worksheets("Activos")
Sheets("Activos").Select
Range("H65536").Select
i = Selection.End(xlUp).Row
Sheets("Activos").Cells(1, 1).Activate
ReDim c(i) As Integer
For Each celda In hoj.Range(Cells(1, 8), Cells(i, 8))
If celda.Value = "X" Or celda.Value = "x" Then
l = l + 1
c(l) = celda.Row
celda.EntireRow.Cut
Sheets("Retirados").Select
Range("A65536").Select
Selection.End(xlUp).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
Next

For i = l To 1 Step -1
hoj.Cells(c(i), 1).EntireRow.Delete
Next

Sheets("Retirados").Cells(1, 1).Activate

End Sub

El ciclo no se hace en toda la columna H sino hasta donde encuentre la
última X ó x


Gavillas ha escrito:

Gracias J.P. ahora si que funciona.
Ademas, tus comentarios por partes son muy instructivos.

Un saludo, Gavillas.

"J.P." escribió en el mensaje
news:
Buen día
Les cuento, disculpen soy muy principiante y cometo errores, que luego
me doy cuenta.
Puedes probar con este codigo, el anterior tenia un error y era que
solo cortaba la primera columna, pues de ahi en adelante ya estaba
ubicado en la hoja retirados.

Sub EliminarRetirados()
Dim celda As Range
Dim c() As Integer
Dim i As Integer
Dim j As Integer
Sheets("Activos").Select
'En esta parte defino cuantas columnas son las que hay que cortar
For Each celda In Range("H:H")
If celda.Value = "X" Then
i = i + 1
End If
Next
'incluyo las columnas en un vector para luego cortarlas
'Es igual que al de arriba pero si quieren el anterior pueden oviarlo y
definir
'c() con algun indice, en la definición, este tiene que ser por lo
menos
'igual a las filas cortadas, por eso opto por realizar el paso anterior
ReDim c(i)
i = 0
For Each celda In Range("H:H")
If celda.Value = "X" Then
i = i + 1
c(i) = celda.Row
End If
Next
'Corto las columnas
For j = 1 To i
Sheets("Activos").Cells(c(j), 1).EntireRow.Cut
Sheets("Retirados").Select
Range("A65536").Select
Selection.End(xlUp).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Next
'borro las columnas
For j = i To 1 Step -1
Sheets("Activos").Cells(c(j), 1).EntireRow.Delete
Next
End Sub

Bueno si alguien sabe como puedo simplificar el codigo para hacer mas
rapida la ejecución, les agradeceria que me lo hicieran saber.

Espero les sirva.
email Siga el debate Respuesta Responder a este mensaje
Ads by Google
Help Hacer una pregunta AnteriorRespuesta Tengo una respuesta
Search Busqueda sugerida