Ayuda con macro

[el poder]

Que tal a todos,

Resulta que tengo la siguiente hoja en excel:

AVC.XLS
	A	B	C	D
1	Hojaentr.	Txt.brv.hojaent.	Val.netohojaent.
2
3	5500001881
4	1
5	1000088839	1ER.AJUSTETRIMESTRAL2006	4,050.64
6
7	5500001881
8	2
9	1000088953	1ER.AJUSTETRIMESTRAL2006	8,783.68
10
11	5500001881
12	3
13	1000088960	1ER.AJUSTETRIMESTRAL2006	92,794.94
AVC

He marcado en amarillo los números del 1 al 3 para indicar que el renglón siguiente a cada uno de ellos los quiero cortar y pegar para que queden en el mismo rengón:

AVC.XLS
	A	B	C	D
1	Hojaentr.	Txt.brv.hojaent.	Val.netohojaent.
2
3	5500001881
4	1	1000088839	1ER.AJUSTETRIMESTRAL2006	4,050.64
5
6
7	5500001881
8	2	1000088953	1ER.AJUSTETRIMESTRAL2006	8,783.68
9
10
11	5500001881
12	3	1000088960	1ER.AJUSTETRIMESTRAL2006	92,794.94
AVC

Tengo la idea de crear un ciclo for que busque sobre la columna "A" los números del 1 al 50 para que se corten y peguen los datos de tal forma que queden como en la segunda hoja. ¿Alguien podría darme alguna sugerencia de favor?


For i = 1 To 50
Select Case Cells(i, "A")
Case Is = 1
Cortar siguiente renglón y pegarlo una celda arriba.
Case Is = 2
Cortar siguiente renglón y pegarlo una celda arriba.
Case Is = 3
Cortar siguiente renglón y pegarlo una celda arriba.
Case Is = .. 50
Cortar siguiente renglón y pegarlo una celda arriba.

..
Next


Saludos y gracias de antemano

 

[Greg Truby]

Hola Poder,

Esto me está funcionando en pruebas.

Sub CutAndRun()
    Dim rngTarget As Range, rngCell As Range
    
    Set rngTarget = Range("A3:A" & Cells(Rows.Count, 1).End(xlUp).Offset(1).Row).SpecialCells(xlCellTypeBlanks)
    
    For Each rngCell In rngTarget.Cells
        With rngCell.Offset(-1).Resize(1, 3)
            .Cut .Offset(-1, 1)
        End With
    Next
End Sub

Note que todavía falta arreglar la cabeza, la cual dejo para una diversión para usted.

Cordialmente,

 

[Greg Truby]

Sabía que debía haber una maner sin bucle...

Sub CutAndRunQuicker()
    Range("A3:A" & Cells(Rows.Count, 1).End(xlUp).Offset(1).Row).SpecialCells(xlCellTypeBlanks).Offset(-1).Insert Shift:=xlToRight
    Range("B2:D2").Delete Shift:=xlUp
End Sub

 

[el poder]

Muchas Gracias Greg,

Intenté las dos opciones que mandaste y en la segunda el último renglón no funcionó. Estoy analizándolo y no encuentro la posible falla, abusando de tu generosidad, ¿podrías dar una breve explicación de lo que hacen las macros o cómo lo hacen?

Por mi parte también intenté hacerlo y llegué al siguiente código, que obviamente no estan eficiente como el tuyo:

Sub Hojas()

For x = 3 To 199 Step 4 'Te colocas en B7 y saltas 4 renglones
Cells(x, 2).Select 'Para cada celda cortas y pegas
ActiveCell.Offset(0, 0).Select
Selection.Cut
ActiveCell.Offset(1, -1).Select
ActiveSheet.Paste
Next x

' Define la columna sobre la que quieres borrar los renglones

Range("C:C").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Range("A1").Select 'Colócate al principio de la hoja

End Sub

Como podrás notar la hoja real tiene muchos más registros e hice la macro considerando que hay una repetición cada 4 renglones.

Sin duda utilizaré tus opciones ya que son más elegantes y rápidas.

Gracias por tu tiempo!

 

[Greg Truby]

Bueno, favor perdonarme por haber demorado tanto en responder, pero querría hacer una buena explicación y eso toma un poco de tiempo... ¿empezamos mordisco por mordisco?

Range("A3:A

Vamos a hacer algo con un rango de celdas empezando con celda A3 y quedando dentro de la columna A.

" & Cells(

Brincamos a la celda en

Rows.Count,1)

la última fila - la celda con el número de fila que iguala a la cuenta total de filas - y la primera columna

.End(xlUp)

de allí vamos de abajo para arriba hasta que topemos con una celda ocupada. En otras palabras vamos a la última celda ocupada.

De esta última celda ocupada

.Offset(1)

nos movemos una ringlón para abajo. De esta celda,

.Row)

sacamos el número de fila. Agregando ese número de fila con el texto "A3:A" vamos a tener una dirección como "A3:A14" usando el ejemplo que proveiste.

Ya que tenemos la dirección del rango en columna A de fila 3 hasta la última fila más una,

.SpecialCells(xlCellTypeBlanks)

agaramos solamente las celdas vacias (blanks). Depués de haber escogido solamente las celdas vacias,

.Offset(-1)

hacemos un Offset de una fila para arriba. En su ejemplo sería A5, A9 y A13. Ahora

.Insert Shift:=xlToRight

insertamos celdas moviendo lo que hay hacia la derecha.

    Range("B2:D2").Delete Shift:=xlUp

Ya que hemos movido todo eso a la derecha si suprimos B2 a D2, todo se reacomada en la posición deseada.<hr />

Haciendo la mismo a mano sería...

1. Hacer un cliq en celda A3
2. En la cajita de direcciones al lado izquierda de la barra de formulas teclar A65536, presionar la tecla Shift y teclar Enter y mantiendo Shift presionado, teclar End y flecha para arriba
   
   
3. Del menú escoger Edit | GoTo o Ctrl+G
   
   
4. En la caja de díalogo que se presente hay un botón «Special»
   
   
5. haciendo el «cliq» se ve
   
   
6. Escogemos Blanks y eso escoge solamento las celdas vacias
   
   
7. Es este próximo paso que no sé como uno haría manualmente que es seleccionar las celda una fila más arriba
   
   
8. Ya con esta celdas seleccionadas, insertamos celdas
   
   
9. y decimos a Excel que quermos mover celdas existentes hacia la derecha.
   
   
10. Esto acomoda las celdas en las columnas deseadas.
    
    
11. Ahora seleccionamos las celdas B2 a D2
    
    
12. Del menú Edit | Delete...
    
    
13. Y hacer un Shift hacia arriba
    
    
14. Y ya debemos tener los resultados deseados

 

[el poder]

Impresionante Greg ,

Qué nivel de detalle, muchísimas gracias!!!

 

[Baltasar Gracián]

Bucle BuscarV en cada hoja

Hola,

recientemente adquirí un libro de Excel Macros y VBA de Bill Jelen y Tracy Syrstad para iniciarme en el tema y intentar mejorar las tareas repetitivas en mi trabajo.

Habitualmente utilizo un archivo de control de stock al que asigno un ahoja por día (stock al final del día) P.ej en la hoja 1:

<TABLE style="WIDTH: 374pt; BORDER-COLLAPSE: collapse" cellSpacing=0 cellPadding=0 width=499 border=0 x:str><COLGROUP><COL style="WIDTH: 60pt" width=80><COL style="WIDTH: 74pt; mso-width-source: userset; mso-width-alt: 3620" width=99><COL style="WIDTH: 60pt" span=4 width=80><TBODY><TR style="HEIGHT: 12.75pt" height=17><TD class=xl26 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; WIDTH: 134pt; BORDER-BOTTOM: #ece9d8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent; mso-ignore: colspan" width=179 colSpan=2 height=17>STOCK A 02/01/2010 (Uds en Kg) </TD><TD class=xl24 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; WIDTH: 60pt; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" width=80></TD><TD class=xl24 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; WIDTH: 60pt; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" width=80></TD><TD class=xl24 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; WIDTH: 60pt; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" width=80></TD><TD class=xl24 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; WIDTH: 60pt; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" width=80></TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl24 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" height=17></TD><TD class=xl24 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent"></TD><TD class=xl24 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent"></TD><TD class=xl24 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent"></TD><TD class=xl24 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent"></TD><TD class=xl24 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent"></TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl24 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" height=17>COD</TD><TD class=xl24 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent">DESCRIPCION</TD><TD class=xl25 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" x:num="40179">01/01/2010</TD><TD class=xl24 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent">ENTRADAS</TD><TD class=xl24 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent">SALIDAS</TD><TD class=xl25 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" x:num="40180">02/01/2010</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl24 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" height=17 x:num>30303</TD><TD class=xl24 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent">ALUBIAS BL</TD><TD class=xl24 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" x:num>100</TD><TD class=xl24 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" x:num>10</TD><TD class=xl24 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" x:num>5</TD><TD class=xl24 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" x:num x:fmla="=C4+D4-E4">105</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl24 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" height=17 x:num>30335


</TD><TD class=xl24 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent">ALUBIAS RJ.


</TD><TD class=xl24 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" x:num>50


</TD><TD class=xl24 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" x:num>5


</TD><TD class=xl24 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" x:num>5


</TD><TD class=xl24 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" x:num x:fmla="=C5+D5-E5">50


</TD></TR></TBODY></TABLE>
El problema es cuando quiero hacer un seguimiento de los movimientos de un artículo debo ir consultando hoja por hoja. Estoy intentando crear una macro que efectúe un bucle por cada hoja con la función buscarV de manera que atendiendo al código de artículo me indique todas las entradas
y/o salidas del artículo.

No sé como aplicar el bucle a cada hoja:

Sub Macro1()
For Each ws In ThisWorkbook.Worksheets
ActiveCell.FormulaR1C1 = "=VLOOKUP(R[-1]C,Hoja1!C:C[4],2,FALSE)"

Gracias por anticipado a vuestras ayudas y comentarios
Slds

 

[Greg Truby]

Re: Bucle BuscarV en cada hoja

Hola Baltasar y bienvenido a MrExcel.<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>


Para poder ayudarle mejor, ¿nos puede dar un ejemplo de la hoja donde estarán ubicadas las fórmulas creadas por el macro?<o></o>

Se puede usar ASAP Utilities o ExcelJeanie para pegar usando HTML.<o></o>

Atentamente,