Anónimo
Me podrían programar un macro para cambiar datos d
Hola tengo unos datos de la siguiente manera:
A B C D E
1 Caso 1 - 12 - 43 - 65 - b
2 Caso 1 - 43 - 87 - 54 - a
3 Caso 1 - 62 - 43 - 65 - b
4 Caso 2 - 43 - 87 - 54 - a
5 Caso 2 - 12 - 43 - 65 - b
6 Caso 3 - 43 - 87 - 54 - a
7 Caso 4 - 62 - 43 - 65 - b
8 Caso 4 - 43 - 87 - 54 - a
Y quiero que en otra hoja queden así:
A B C D E F G H I J K L M N O Q
1 Caso 1-12-43-65-b-Caso 1-43-87-54-a-Caso 1-62-43-65-b
2 Caso 2-43-87-54-a-Caso 2-12-43-65-b
3 Caso 3-43-89-54-a
4 Caso 4-62-43-65-b-Caso 4-43-88-54-a
Es decir, que para cada caso (individuo) los rangos de datos que están hacia abajo, queden hacia el lado.
Muchas gracias!
A B C D E
1 Caso 1 - 12 - 43 - 65 - b
2 Caso 1 - 43 - 87 - 54 - a
3 Caso 1 - 62 - 43 - 65 - b
4 Caso 2 - 43 - 87 - 54 - a
5 Caso 2 - 12 - 43 - 65 - b
6 Caso 3 - 43 - 87 - 54 - a
7 Caso 4 - 62 - 43 - 65 - b
8 Caso 4 - 43 - 87 - 54 - a
Y quiero que en otra hoja queden así:
A B C D E F G H I J K L M N O Q
1 Caso 1-12-43-65-b-Caso 1-43-87-54-a-Caso 1-62-43-65-b
2 Caso 2-43-87-54-a-Caso 2-12-43-65-b
3 Caso 3-43-89-54-a
4 Caso 4-62-43-65-b-Caso 4-43-88-54-a
Es decir, que para cada caso (individuo) los rangos de datos que están hacia abajo, queden hacia el lado.
Muchas gracias!
1 respuesta
Respuesta de hackmatealfa
1
Disculpa que haya demorado con la solución de tu problema.
Aquí el código que soluciona el problemita.
Nota:
- La hoja uno todas las celdas tendrán que tener como formato TEXTO
- La hoja uno tendrá que estar activa cuando se ejecute la macro.
- Las celdas de la Hoja 1 no deberá contener celdas vacías.
- El encabezado tendrás que llenarlo manualmente.
Aquí el código de la macro que ayudará a la solución de tu problema.
-----------------------------------http://alexcastaneda.blogspot.com-------------------------------------
Sub formatodedatos()
'
' formatodedatos Macro
'
' Acceso directo: CTRL+w
'
Dim fil As Integer
Dim i As Integer
Dim j As Integer
Dim l As Integer
Dim m As Integer
Dim h As Integer
Dim ultimafila As Integer
Dim existe As Boolean
fil = Hoja1.UsedRange.Row - 1 + Hoja1.UsedRange.Rows.Count
'fil = 9
For i = 2 To fil
existe = False
ultimafila = Hoja3.UsedRange.Row - 1 + Hoja3.UsedRange.Rows.Count
'verificamos si existe el mismo código en la hoja3
For l = 2 To ultimafila
If Cells(i, 1) = Hoja3.Cells(l, 1) Then
existe = True 'indicara si en la hoja resultados existe el mismo id
Exit For
End If
Next
If existe = True Then
Do
m = m + 1 'indicara la última columna utilizada
Loop While (Hoja3.Cells(l, m).Text <> "")
h = 1
m = m - 1
Do
Hoja3.Cells(l, m) = Cells(i, h)
h = h + 1
m = m + 1
Loop While (Cells(i, h).Text <> "")
existe = False
Else 'para validar cuando es la primera vez que se agrega
h = 1
m = 1
l = Hoja3.UsedRange.Row + Hoja3.UsedRange.Rows.Count
Do
Hoja3.Cells(l, m) = Cells(i, h)
h = h + 1
m = m + 1
Loop While (Cells(i, h).Text <> "")
existe = False
End If
Next
End Sub
-----------------------------------http://alexcastaneda.blogspot.com-------------------------------------
Cualquier problema o modificación con la macro, por favor avisame y estaré contento en ayudarte.
Aquí el código que soluciona el problemita.
Nota:
- La hoja uno todas las celdas tendrán que tener como formato TEXTO
- La hoja uno tendrá que estar activa cuando se ejecute la macro.
- Las celdas de la Hoja 1 no deberá contener celdas vacías.
- El encabezado tendrás que llenarlo manualmente.
Aquí el código de la macro que ayudará a la solución de tu problema.
-----------------------------------http://alexcastaneda.blogspot.com-------------------------------------
Sub formatodedatos()
'
' formatodedatos Macro
'
' Acceso directo: CTRL+w
'
Dim fil As Integer
Dim i As Integer
Dim j As Integer
Dim l As Integer
Dim m As Integer
Dim h As Integer
Dim ultimafila As Integer
Dim existe As Boolean
fil = Hoja1.UsedRange.Row - 1 + Hoja1.UsedRange.Rows.Count
'fil = 9
For i = 2 To fil
existe = False
ultimafila = Hoja3.UsedRange.Row - 1 + Hoja3.UsedRange.Rows.Count
'verificamos si existe el mismo código en la hoja3
For l = 2 To ultimafila
If Cells(i, 1) = Hoja3.Cells(l, 1) Then
existe = True 'indicara si en la hoja resultados existe el mismo id
Exit For
End If
Next
If existe = True Then
Do
m = m + 1 'indicara la última columna utilizada
Loop While (Hoja3.Cells(l, m).Text <> "")
h = 1
m = m - 1
Do
Hoja3.Cells(l, m) = Cells(i, h)
h = h + 1
m = m + 1
Loop While (Cells(i, h).Text <> "")
existe = False
Else 'para validar cuando es la primera vez que se agrega
h = 1
m = 1
l = Hoja3.UsedRange.Row + Hoja3.UsedRange.Rows.Count
Do
Hoja3.Cells(l, m) = Cells(i, h)
h = h + 1
m = m + 1
Loop While (Cells(i, h).Text <> "")
existe = False
End If
Next
End Sub
-----------------------------------http://alexcastaneda.blogspot.com-------------------------------------
Cualquier problema o modificación con la macro, por favor avisame y estaré contento en ayudarte.
Hola!
Muchas gracias por tu ayuda...
Te cuento que no me resulta la ejecución... me sale error 424 y en el depurardo hace referencia a esta línea...
ultimafila = Hoja3.UsedRange.Row - 1 + Hoja3.UsedRange.Rows.Count
Yo pienso, que como no me manejo, en algo estoy cometiendo un error.
Muchas gracias!
Muchas gracias por tu ayuda...
Te cuento que no me resulta la ejecución... me sale error 424 y en el depurardo hace referencia a esta línea...
ultimafila = Hoja3.UsedRange.Row - 1 + Hoja3.UsedRange.Rows.Count
Yo pienso, que como no me manejo, en algo estoy cometiendo un error.
Muchas gracias!
Bueno la variable ultima fila se refiere al último número de celda que contiene datos para evaluar, por ejemplo si los datos a evaluar terminan en en A35 entonces ultimafila = 35, Por lo que te recomiendo cambies ultimafila = Hoja3. UsedRange.Row - 1 + Hoja3. UsedRange. Rows. Count y pongas tu el valor, por ejemplo ultimafila = 230 o ultimafila = 123.
Si aún así no te funciona, por favor dejame tu correo y yo te agrego al msn para darte más detalles de la implementación.
Si aún así no te funciona, por favor dejame tu correo y yo te agrego al msn para darte más detalles de la implementación.
Realmente no entiendo... disculpa, pero realmente no sé nada de programación...
mi correo es
mi correo es
Disculpa la demora, tenía problemas con la conexión a internet, y quizás los siga teniendo, pero acabo de agregarte al msn, espero poder ayudar.
Estimado:
Logré entender lo que me explicaste... y la macro funciona muy bien!
No sabes lo que me has ayudado y el tiempo que he ganado!
Muchísimas gracias!
Logré entender lo que me explicaste... y la macro funciona muy bien!
No sabes lo que me has ayudado y el tiempo que he ganado!
Muchísimas gracias!
Que bueno amigo, estoy muy contento... bueno ahora te pido publiques el código último, y que cierres la pregunta por favor.
Muchísimas gracias!
Realmente me has ahorrado mucho tiempo y he automatizado un importante proceso de mi trabajo. Muchas gracias por la permanente y excelente disposición, y por supuesto, experiencia y pericia.
Adjunto el código como quedó finalmente:
Sub Registros_en_Columnas_a_Filas()
'
' formatodedatos Macro
'
' Acceso directo: CTRL+w
'
Dim fil As Integer
Dim i As Integer
Dim j As Integer
Dim l As Integer
Dim m As Integer
Dim h As Integer
Dim ultimafila As Integer
Dim existe As Boolean
fil = Worksheets("Hoja1").Range("2:2000").Row - 1 + Worksheets("Hoja1").Range("2:2000").Rows.Count
'fil =
For i = 2 To fil
existe = False
ultimafila = Worksheets("Hoja3").UsedRange.Row - 1 + Worksheets("Hoja3").UsedRange.Rows.Count
'verificamos si existe el mismo código en la hoja3
For l = 2 To ultimafila
If Cells(i, 1) = Worksheets("Hoja3").Cells(l, 1) Then
existe = True 'indicara si en la hoja resultados existe el mismo id
Exit For
End If
Next
If existe = True Then
Do
m = m + 1 'indicara la última columna utilizada
Loop While (Worksheets("Hoja3").Cells(l, m).Text <> "")
h = 1
m = m - 1
Do
Worksheets(3).Cells(l, m) = Cells(i, h)
h = h + 1
m = m + 1
Loop While (Cells(i, h).Text <> "")
existe = False
Else 'para validar cuando es la primera vez que se agrega
h = 1
m = 1
l = Worksheets("Hoja3").UsedRange.Row + Worksheets("Hoja3").UsedRange.Rows.Count
Do
Worksheets("Hoja3").Cells(l, m) = Cells(i, h)
h = h + 1
m = m + 1
Loop While (Cells(i, h).Text <> "")
existe = False
End If
Next
End Sub
Excelente!
Realmente me has ahorrado mucho tiempo y he automatizado un importante proceso de mi trabajo. Muchas gracias por la permanente y excelente disposición, y por supuesto, experiencia y pericia.
Adjunto el código como quedó finalmente:
Sub Registros_en_Columnas_a_Filas()
'
' formatodedatos Macro
'
' Acceso directo: CTRL+w
'
Dim fil As Integer
Dim i As Integer
Dim j As Integer
Dim l As Integer
Dim m As Integer
Dim h As Integer
Dim ultimafila As Integer
Dim existe As Boolean
fil = Worksheets("Hoja1").Range("2:2000").Row - 1 + Worksheets("Hoja1").Range("2:2000").Rows.Count
'fil =
For i = 2 To fil
existe = False
ultimafila = Worksheets("Hoja3").UsedRange.Row - 1 + Worksheets("Hoja3").UsedRange.Rows.Count
'verificamos si existe el mismo código en la hoja3
For l = 2 To ultimafila
If Cells(i, 1) = Worksheets("Hoja3").Cells(l, 1) Then
existe = True 'indicara si en la hoja resultados existe el mismo id
Exit For
End If
Next
If existe = True Then
Do
m = m + 1 'indicara la última columna utilizada
Loop While (Worksheets("Hoja3").Cells(l, m).Text <> "")
h = 1
m = m - 1
Do
Worksheets(3).Cells(l, m) = Cells(i, h)
h = h + 1
m = m + 1
Loop While (Cells(i, h).Text <> "")
existe = False
Else 'para validar cuando es la primera vez que se agrega
h = 1
m = 1
l = Worksheets("Hoja3").UsedRange.Row + Worksheets("Hoja3").UsedRange.Rows.Count
Do
Worksheets("Hoja3").Cells(l, m) = Cells(i, h)
h = h + 1
m = m + 1
Loop While (Cells(i, h).Text <> "")
existe = False
End If
Next
End Sub
Excelente!