Bucle para Copiar, pegar con Transpose

23/08/2009 - 05:04 por sebastico | Informe spam
Hola amigos

He encontrado el siguiente código que me permite copiar y ejecutar la
función transpose con miles de datos.

Option Explicit
Sub testme()
Dim wks As Worksheet
Dim DestCell As Range
Dim iRow As Long

Set wks = Worksheets("Sheet1") ' or ActiveSheet

Set DestCell = Worksheets("Sheet2").Range("a1")

With wks
For iRow = 2 To 632
' or last used cell in column A
'for irow = 2 to .Cells(.Rows.Count, "A").End(xlUp).Row
.Cells(iRow, "A").Resize(1, .Range("o1").Column).Copy
DestCell.PasteSpecial _
Paste:=xlPasteAll, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=True
Set DestCell = DestCell.Offset(18, 0)
Next iRow
End With
End Sub

Ese código ordena todos los datos en una sola columna. Sin embargo, debido a
que no se como indicar que solo copie las celdas con datos, el código recorre
las 18 celdas de cada fila con o sin datos (creo que lo hace con .Cells(iRow,
"A").Resize(1, .Range("o1").Column).Copy ), y las copia y pega con el
trasnpose en las 18 celdas de otra columna (con Set DestCell =
DestCell.Offset(18, 0) ).

Desafortunadamente para mi, colocar a mano la primera celda como código
identificador en la celda de la columna contigua me lleva, también, mucho
trabajo y tiempo.

Como lo indico el rango de fila es diferente por ejemplo:

Fila A1 B1 C1 D1 E1 F1 G1 H1 I1 J1 K1 L1 M1 N1 01
Datos 1 4 2 1 8 6 9 2 4 7 1 8 5 1 3

Fila A2 B2 C2 D2 E2 F2 G2 H2 J1
Datos 3 2 7 5 1 4 8 1 5
.
.
.
A107 B107
4 7
.
.
A632 B632 C632 D632 E532
6 9 2 7 5

Necesito que al correr el código con la instrucción que busco con la ayuda
de ustedes, el TRANSPOSE ordene las filas asi:

A B
1 4
1 4
1 2
1 1
1 8
1 6
1 9
1 2
1 4
1 7
1 1
1 8
1 5
1 1
1 3

A B
3 2
3 2
3 7
3 5
3 1
3 4
3 8
3 1
3 5

A B
4 7

A B
6 9
6 2
6 7
6 5


Hasta copiar la fila 631. Obsérvese que la primera celda de cada fila se
copia en las celdas de la columna contigua en este caso en A.

Podrian sugerirme que hacer pues acomodar los datos a mano me lleva más de
un dia y puedo cometer errores, como ya lo he comprobado.

Muchas gracias y Salud2

Preguntas similare

Leer las respuestas

#11 sebastico
25/08/2009 - 07:55 | Informe spam
Agradezco tu amabilidad Héctor Miguel.

A ver:
Hay 631 filas. Todas las filas tienen diferente cantidad de datos (un dato
por celda). Hay celdas vacías.

El código que me enviaste coloca todos los datos en dos columnas, pero, pega
un número fijo de columnas (18) copiando el dato que está en la primera celda
de cada fila. Sin embargo, lo que necesito es que los datos en las dos
columnas tengan la misma cantidad de celdas. En sintensis los datos de la
columna B estan bien, pero no los de la columna A.

Una vez más muchas gracias por tu atención.


"Héctor Miguel" wrote:

hola (...), ?????

__ 1 __
> He tratado de corregir el codigo con tus sugerencias, para que el programa
> ordene los datos en columnas A y B del Sheet1 segun me deseo, pero, he fracasado.
> Incluso el codigo no lee las primeras dos filas de la Sheet1.

1) antes de todo, considera que aun hay dos o tres (re)preguntas a las que no has dado respuesta (p.e.)
- cuando hay menos columnas, la columnas "no necesarias" estan REALMENTE vacias ???
- que significa "ordenar los datos" en las columnas A y B del "Sheet1" ???

__ 2 __
> Debo decir que en el Sheet1 hay filas que tienen solo un dato (string), otras 5, etc y otras hasta 18, el numero es variable.
> Es mi deseo solucionar el inconveniente que tengo para que solo copie las filas que tienen datos.

2) (creo que) esta parte es similar al primer apartado del punto anterior (me explico)
que es lo que determina si alguna fila (de la sheet1) tiene datos o no ???

__ 3 __
> ... no entiendo bien las instrucciones. Me podrias ayudar a describir que hace cada instruccion, las cuales he numerado...

3) me gustaria (de ser posible) que primero dejes claras "mis dudas" comentadas en este y anteriores mensajes (???)

saludos,
hector.



Respuesta Responder a este mensaje
#12 Héctor Miguel
25/08/2009 - 08:29 | Informe spam
hola, ?

Hay 631 filas. Todas las filas tienen diferente cantidad de datos (un dato por celda). Hay celdas vacias.
El codigo que me enviaste coloca todos los datos en dos columnas, pero, pega un numero fijo de columnas (18)
copiando el dato que esta en la primera celda de cada fila.
Sin embargo, lo que necesito es que los datos en las dos columnas tengan la misma cantidad de celdas.
En sintensis los datos de la columna B estan bien, pero no los de la columna A...



a ver... haciendo un ligero intercambio de lineas, prueba con la siguiente macro:

Sub Copiar_transpuesto()
Dim Fila As Integer, Cols As Byte, nFila As Integer
Application.ScreenUpdating = False
nFila = 1
With Worksheets("sheet1")
For Fila = 1 To 631
Cols = Application.CountA(.Range("a" & Fila).EntireRow) - 1
Worksheets("sheet2").Range("a" & nFila).Resize(Cols).Value = _
.Range("a" & Fila).Value
Worksheets("sheet2").Range("b" & nFila).Resize(Cols).Value = _
Application.Transpose(.Range("b" & Fila).Resize(, Cols).Value)
nFila = Worksheets("sheet2").Range("a65536").End(xlUp).Row + 3
Next
End With
End Sub

si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.
Respuesta Responder a este mensaje
#13 sebastico
25/08/2009 - 13:22 | Informe spam
Muchas gracias Héctor Miguel

Ahora si funciona tal y como necesito agrupar los datos. Ahora no tendré
errores al copiar y pegar que hacia de manera manual.

Me ha sido difícil entender que hace cada instrucción. Yo he aprendido los
fundamentos para modelar la programamcion, pero, desconozco la codificación.
Voy a revisar las insturrcuiones para tratar de aprender la lógica.

Salud2

"Héctor Miguel" wrote:

hola, ?

> Hay 631 filas. Todas las filas tienen diferente cantidad de datos (un dato por celda). Hay celdas vacias.
> El codigo que me enviaste coloca todos los datos en dos columnas, pero, pega un numero fijo de columnas (18)
> copiando el dato que esta en la primera celda de cada fila.
> Sin embargo, lo que necesito es que los datos en las dos columnas tengan la misma cantidad de celdas.
> En sintensis los datos de la columna B estan bien, pero no los de la columna A...

a ver... haciendo un ligero intercambio de lineas, prueba con la siguiente macro:

Sub Copiar_transpuesto()
Dim Fila As Integer, Cols As Byte, nFila As Integer
Application.ScreenUpdating = False
nFila = 1
With Worksheets("sheet1")
For Fila = 1 To 631
Cols = Application.CountA(.Range("a" & Fila).EntireRow) - 1
Worksheets("sheet2").Range("a" & nFila).Resize(Cols).Value = _
.Range("a" & Fila).Value
Worksheets("sheet2").Range("b" & nFila).Resize(Cols).Value = _
Application.Transpose(.Range("b" & Fila).Resize(, Cols).Value)
nFila = Worksheets("sheet2").Range("a65536").End(xlUp).Row + 3
Next
End With
End Sub

si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.



Respuesta Responder a este mensaje
#14 Héctor Miguel
25/08/2009 - 19:59 | Informe spam
hola (como sea que te llames), !

Ahora si funciona tal y como necesito agrupar los datos.
Ahora no tendre errores al copiar y pegar que hacia de manera manual.
Me ha sido dificil entender que hace cada instruccion.
Yo he aprendido los fundamentos para modelar la programamcion, pero, desconozco la codificacion.
Voy a revisar las insturrcuiones para tratar de aprender la logica...



te paso el mismo codigo agregando comentarios (por si te resulta mas facil el analisis de "que hace" cada linea)
saludos,
hector.

Sub Copiar_transpuesto()

' declaracion de las variables necesarias
Dim Fila As Integer, Cols As Byte, nFila As Integer
' Fila: variable para avanzar de 1 a 631 filas en la sheet1
' Col: variable para determinar cuantas celdas/columnas por fila tienen datos
' nFila: variable para determinar la siguiente fila libre en la sheet2

' instruccion para congelar el "refresco" de la pantalla y agilizar el proceso
Application.ScreenUpdating = False

' establecemos la primer fila libre (sheet2) como la fila 1
nFila = 1

' bloque with (para no "repetir" el objeto Worksheets("sheet1")
With Worksheets("sheet1")

' bucle para avanzar por las filas 1 a 631 de la hoja en el bloque With
For Fila = 1 To 631

' obtenemos cuantas celdas contienen datos en la fila de cada ciclo
Cols = Application.CountA(.Range("a" & Fila).EntireRow) - 1

' ampliamos la fila libre (nFila) col A de sheet2 segun las celdas con datos (Col) _
y pegamos en todas el contenido de la columna A (de la sheet1)
Worksheets("sheet2").Range("a" & nFila).Resize(Cols).Value = _
.Range("a" & Fila).Value

' ampliamos la fila libre (nFila) col B de sheet2 segun las celdas con datos (Col) _
y pegamos "transpuestos" los valores de las celdas ocupadas (sheet1) fila en turno
Worksheets("sheet2").Range("b" & nFila).Resize(Cols).Value = _
Application.Transpose(.Range("b" & Fila).Resize(, Cols).Value)

' obtenemos la siguiente fila libre (sheet2) y agregamos 3 para dejar 2 filas "en blanco"
nFila = Worksheets("sheet2").Range("a65536").End(xlUp).Row + 3

' siguiente fila a procesar ...
Next

' final de bloque With (las referencias a Worksheets("sheet1") se inician con un punto
End With

' final del procedimiento, se (auto)restablece el "refresco" de la pantalla
End Sub
Respuesta Responder a este mensaje
#15 sebastico
27/08/2009 - 11:59 | Informe spam
Hola Héctor
Muchas gracias. Ahora podre estudiar la sintaxis de la codificación

"Héctor Miguel" wrote:

hola (como sea que te llames), !

> Ahora si funciona tal y como necesito agrupar los datos.
> Ahora no tendre errores al copiar y pegar que hacia de manera manual.
> Me ha sido dificil entender que hace cada instruccion.
> Yo he aprendido los fundamentos para modelar la programamcion, pero, desconozco la codificacion.
> Voy a revisar las insturrcuiones para tratar de aprender la logica...

te paso el mismo codigo agregando comentarios (por si te resulta mas facil el analisis de "que hace" cada linea)
saludos,
hector.

Sub Copiar_transpuesto()

' declaracion de las variables necesarias
Dim Fila As Integer, Cols As Byte, nFila As Integer
' Fila: variable para avanzar de 1 a 631 filas en la sheet1
' Col: variable para determinar cuantas celdas/columnas por fila tienen datos
' nFila: variable para determinar la siguiente fila libre en la sheet2

' instruccion para congelar el "refresco" de la pantalla y agilizar el proceso
Application.ScreenUpdating = False

' establecemos la primer fila libre (sheet2) como la fila 1
nFila = 1

' bloque with (para no "repetir" el objeto Worksheets("sheet1")
With Worksheets("sheet1")

' bucle para avanzar por las filas 1 a 631 de la hoja en el bloque With
For Fila = 1 To 631

' obtenemos cuantas celdas contienen datos en la fila de cada ciclo
Cols = Application.CountA(.Range("a" & Fila).EntireRow) - 1

' ampliamos la fila libre (nFila) col A de sheet2 segun las celdas con datos (Col) _
y pegamos en todas el contenido de la columna A (de la sheet1)
Worksheets("sheet2").Range("a" & nFila).Resize(Cols).Value = _
.Range("a" & Fila).Value

' ampliamos la fila libre (nFila) col B de sheet2 segun las celdas con datos (Col) _
y pegamos "transpuestos" los valores de las celdas ocupadas (sheet1) fila en turno
Worksheets("sheet2").Range("b" & nFila).Resize(Cols).Value = _
Application.Transpose(.Range("b" & Fila).Resize(, Cols).Value)

' obtenemos la siguiente fila libre (sheet2) y agregamos 3 para dejar 2 filas "en blanco"
nFila = Worksheets("sheet2").Range("a65536").End(xlUp).Row + 3

' siguiente fila a procesar ...
Next

' final de bloque With (las referencias a Worksheets("sheet1") se inician con un punto
End With

' final del procedimiento, se (auto)restablece el "refresco" de la pantalla
End Sub



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