Macro excel

Hola, quisiera pedirte una ayudita para lo siguiente:
En excel tengo parejas de datos horizontales y necesito convertirlos a verticales, como son parejas, la transpuesta no me funciona, estoy tratando de recorrerlo almacenando los valores en una matriz, ya grabo una fila, lo que no he podido realizar es escribirla y hacerlo verticalmente conservando las parejas, hasta ahora este es mi código:
Sub prueba()
Dim Fila
Dim Columna
ReDim Matriz(1 To 12, 2 To 37)
For Fila = 1 To 17
For Columna = 2 To 37 Step 2
Matriz(Fila, Columna) = Sheets(1).Cells(Fila, Columna).Value
Next
Next
End Sub
Agradezco tu colaboración.
Respuesta
1
Disculpame, pero estoy un poco lento.
Supongo que tenés un número de filas par.
Las celdas las de las filas 1 y 2 forman pares, ej a1/a2 (a1 con a)2, b1/b2 , c1/c2 , ..., ak1/ak2.
Lo mismo las celdas de las filas 3y4, 5y6, ..., 11y12.
Vos querés tener al final solo 2 columnas, cada fila una pareja.
Si en el origen tenías 12 filas y 37 columnas (444 celdas) . Al final tendrías 2 columnas * 222 filas (444 celdas).
Si así fuera, no es necesario almacenar en una matriz los datos, sino que es posible volcarlos en otra hoja .
La rutina de abajo supone 12 filas y 36 columnas (2 a 37)
Con datos.
Los vuelca en 2 columnas y
216 filas.
El único TRUCO es usar un contador nf (nueva fila) para ir incrementando la fila de la hoja destino.
Sub fjprueba()
Dim nf As Long
Dim Fila As Integer
Dim Columna As Integer
nf = 1
For Fila = 1 To 12 Step 2
For Columna = 2 To 37
Sheets(2).Cells(nf, 1).Value = Sheets(1).Cells(Fila, Columna).Value
Sheets(2).Cells(nf, 2).Value = Sheets(1).Cells(Fila + 1, Columna).Value
nf = nf + 1
Next
Next
End Sub
Espero haber entendido bien el enunciado, pero si así no fuera, haceme las aclaraciones o modificaciones que quieras, que con mucho gusto te voy a responder.
Suerte.
Te cuento que esta de una alita para que funcione, mira, el asunto es:
Cada fila corresponde a un mes que tiene parejas de datos y hay que transponer ese grupo, por fila, así:
ENERO(1,3)(4,5)(6,7)
Donde cada numero esta en una celda diferente y lo quiero dejar:
Enero
(1,3)
(4,5)
(6,7)
Tu procedimiento esta perfecto, pero no me di mañas para cuadrarlo así, ¿me ayudas?
Gracias
Marleny
Marleny:
Voy a darte 2 versiones
Ambas para 12 filas y 36 columnas. Cada fila es un mes
La primera cumple con ...
ENERO(2,3)(4,5)(6,7)...(36,37)
Dim nf As Long
Dim Fila As Integer
Dim Columna As Integer
nf = 1
For Fila = 1 To 12 Step 1
For Columna = 2 To 37 Step 2
Sheets(2).Cells(nf, 1).Value = Sheets(1).Cells(Fila, Columna).Value
Sheets(2).Cells(nf, 2).Value = Sheets(1).Cells(Fila, Columna + 1).Value
nf = nf + 1
Next
Next
End Sub
******************
La segunda (tener presente la primera pareja) que cumple con ...
ENERO(1,3)(4,5)(6,7)...(36,37)
es :
Sub fjprueba2()
Dim nf As Long
Dim Fila As Integer
Dim Columna As Integer
nf = 1
For Fila = 1 To 12 Step 1
For Columna = 2 To 37 Step 2
If Columna = 2 Then
Sheets(2).Cells(nf, 1).Value = Sheets(1).Cells(Fila, Columna - 1).Value
Sheets(2).Cells(nf, 2).Value = Sheets(1).Cells(Fila, Columna + 1).Value
Else
Sheets(2).Cells(nf, 1).Value = Sheets(1).Cells(Fila, Columna).Value
Sheets(2).Cells(nf, 2).Value = Sheets(1).Cells(Fila, Columna + 1).Value
End If
nf = nf + 1
Next
Next
End Sub
Espero haberte ayudado.
Suerte.
FJ

2 respuestas más de otros expertos

Respuesta
1
No esta complicado lo que quieres, solo que no entendí muy bien lo de las parejas, supongo que tienes
D1 D1 D2 D2 D3 D3 D4 D4
Y lo quieres
D1 D1
D2 D2
D3 D3
D4 D4
Si es así, solo confírmame, sino, explicame con más detalle, reitero es fácil lo que quieres...
Si, el asunto es:
Enero 12 34
Febrero 15 19
Marzo 20 32
Y quiero que quede:
Enero Febrero Marzo
12 34 15 19 20 32
De acuerdo, pero ¿como están tus columnas
Enero | 12 | 34
Febrero | 15 | 19
Marzo | 20 | 32
y quedaria
Enero | Febrero | Marzo
12 34 | 15 19 |20 32
o
Enero|| Febrero|| Marzo||
12 | 34 | 15 | 19 |20 | 32
Correcto, en una celda esta enero, en otra 12 y en otra 34. Esto es una misma fila y quiero que me queden por columnas, por que son 20 parejas de datos para cada mes por fila y para todos los meses por columnas.
Creo que ya me confundí, pero estoy suponiendo lo siguiente
Enero | 12 | 34 ... | 1 | 2
...
Diciembre | 20 | 32 ... | 5 | 6
Tienes de Enero a Diciembre y en cada fila de cada mes, tienes 20 parejas de datos, para que queden así...
Enero | | ... | Diciembre | |
12 | 34 | ... | 20 | 32
...
1 | 2 | ...| 5 | 6 |
Los meses en fila y sus veinte pares de datos debajo de cada mes, la siguiente macros esta suponiendo que los meses los tienes desde A1 y hasta A12 y los datos en el rango de B1:AO12 que son cuarenta columnas o sea veinte pares de datos, esta macro solo te traspone los datos, de tarea te queda solo poner los meses, casi nada...
Public Sub TrasponerEspecial()
Dim Datos() As Variant
Dim Fila As Integer, Col As Integer
Dim co1 As Integer, co2 As Integer
Datos() = Range("B1:AO12").Value
co1 = 19
co2 = 1
For Fila = 1 To 12
For Col = 1 To 40 Step 2
co1 = co1 + 1
Sheets(1).Cells(co1, co2).Value = Datos(Fila, Col)
Sheets(1).Cells(co1, co2 + 1).Value = Datos(Fila, Col + 1)
Next Col
co2 = co2 + 2
co1 = 19
Next Fila
Erase Datos
End Sub
Respuesta
1
Primero disculpa la demora, pero tuve una semana "agitada"
Respecto a tu pregunta me permito sugerirte un par de fórmulas que resolverán tu problema de pareja -perdón- parejas.
Supongamos que tu fila de parejas empieza en la celda D2 y es algo así:
|A|65|B|66|C|67|D|68|E|69|F|70...
Donde quieras que empiece tu columnas transpuesta ingresa esta fórmula (e.g. en celda A4):
=DESREF($D$2,0,2*(FILA()-FILA($A$3)-1))
(Considera si usas comas o punto y coma para separar argumentos en fórmulas)
Y en la celda a su derecha (B4), esta otra:
=DESREF($D$2;0;2*(FILA()-FILA($A$3))-1)
Luego copia estas dos celdas hacia abajo, tantas como la mitad de celdas ocupadas que tengas en tu fila. De todos modos, si copiaras de más obtendrás ceros después del último par, que luego podrás borrar.
Otro punto de vista para resolver, rápidamente tu problema.
Pruébalo y dime.
Esto debería resolver tu pregunta. Si así fuera, te agradeceré un comentario y que la finalices.
Si no, pregúntame de nuevo.
Un abrazo!
Fernando

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas