Macro para añadir filas
Saludos,
Tengo una hoja excel con la columna B formada por filas con datos de pacientes y la columna A con los campos de dichos datos.
Ej:
A B
NOMBRE: Perico Perez
Los campos con los que estoy trabajando, por orden, son:
Fecha:
Nombre y apellidos:
NIF:
Dirección:
Teléfono:
Enfermedades de interés:
Fármacos:
Alergias:
Intervención quirúrgica:
Implante metálico:
Fecha lesión- tiempo molestias:
¿1º vez que va a fisio, o que le dan un masaje?:
Fecha inicio tratamiento:
Anamnesis y exploración:
Tratamiento:
Evolución:
Fecha de alta:
Nº sesiones:
Observaciones:
Estos campos se repiten para cada paciente, de forma que la hoja excel tiene mil y pico filas y sólo 2 columnas.
Resulta que los campos con los que estoy trabajando no siempre son homogénos y necesito que lo sean. Entonces lo que necesito es una macro que haga lo siguiente:
- Que busque todas las filas de la hoja excel y si falta un campo de los mencionados, cree una fila con contenido: Columna A = Campo y Columna B = Vacío.
Ejemplo:
La macro va leyendo la hoja excel y ve:
FECHA: 12/Marzo/2010
NOMBRE Y APELLIDOS: Perico Perez
NIF: 123456789A
TELÉFONO: 9855566666
Como falta el campo DIRECCIÓN, la macro creará una fila donde en la
Columna A esté DIRECCIÓN: y en la columna B no haya nada.
Resultado:
FECHA: 12/Marzo/2010
NOMBRE Y APELLIDOS: Perico Perez
NIF: 123456789A
Dirección:
TELÉFONO: 9855566666
Solicito amablemente tu ayuda para esto. Muchas gracias por adelantado.
Un saludo,
Bricomatica
Tengo una hoja excel con la columna B formada por filas con datos de pacientes y la columna A con los campos de dichos datos.
Ej:
A B
NOMBRE: Perico Perez
Los campos con los que estoy trabajando, por orden, son:
Fecha:
Nombre y apellidos:
NIF:
Dirección:
Teléfono:
Enfermedades de interés:
Fármacos:
Alergias:
Intervención quirúrgica:
Implante metálico:
Fecha lesión- tiempo molestias:
¿1º vez que va a fisio, o que le dan un masaje?:
Fecha inicio tratamiento:
Anamnesis y exploración:
Tratamiento:
Evolución:
Fecha de alta:
Nº sesiones:
Observaciones:
Estos campos se repiten para cada paciente, de forma que la hoja excel tiene mil y pico filas y sólo 2 columnas.
Resulta que los campos con los que estoy trabajando no siempre son homogénos y necesito que lo sean. Entonces lo que necesito es una macro que haga lo siguiente:
- Que busque todas las filas de la hoja excel y si falta un campo de los mencionados, cree una fila con contenido: Columna A = Campo y Columna B = Vacío.
Ejemplo:
La macro va leyendo la hoja excel y ve:
FECHA: 12/Marzo/2010
NOMBRE Y APELLIDOS: Perico Perez
NIF: 123456789A
TELÉFONO: 9855566666
Como falta el campo DIRECCIÓN, la macro creará una fila donde en la
Columna A esté DIRECCIÓN: y en la columna B no haya nada.
Resultado:
FECHA: 12/Marzo/2010
NOMBRE Y APELLIDOS: Perico Perez
NIF: 123456789A
Dirección:
TELÉFONO: 9855566666
Solicito amablemente tu ayuda para esto. Muchas gracias por adelantado.
Un saludo,
Bricomatica
1 Respuesta
Respuesta de emoren
1
A continuación le dejo una rutina que hace lo que solicita, debe tener en cuenta que en esta rutina debe adecuar los nombres de las hojas y los rangos con referencia a su proyecto, debe insertar una hoja en la cual debe poner desde la celda A1 todos los campos en columna ordenadamente y la rutina la inserta en un modulo tal cual como esta a continuación:
Sub insetar_campos()
Dim x As Integer
x = 19
Sheets("Hoja1").Range("A1").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
For Z = 1 To x
If (ActiveCell.Value = Sheets("Hoja2").Range("A" & Z).Value) Then
ActiveCell.Offset(1, 0).Activate
Else
If (ActiveCell.Value <> Sheets("Hoja2").Range("A" & Z).Value) Then
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Value = Sheets("Hoja2").Range("A" & Z).Value
ActiveCell.Offset(1, 0).Activate
End If
End If
Next
If (ActiveCell.Value = Empty) Then
Else
ActiveCell.Offset(-1, 0).Activate
End If
Loop
End Sub
Espero mi ayuda le sea de utilidad, si ud gusta me escribe un correo a donde le pueda enviar el archivo como lo hice para que vea su funcionamiento, esta macro si la adecua bien le debe funcionar de 10, a mi me funciono, recuerde que cualquier duda me puede consultar en mi perfil que con gusto le colaboro, POR FAVOR NO OLVIDAR PUNTUAR Y FINALIZAR LA PREGUNTA, que tenga un feliz día!
Sub insetar_campos()
Dim x As Integer
x = 19
Sheets("Hoja1").Range("A1").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
For Z = 1 To x
If (ActiveCell.Value = Sheets("Hoja2").Range("A" & Z).Value) Then
ActiveCell.Offset(1, 0).Activate
Else
If (ActiveCell.Value <> Sheets("Hoja2").Range("A" & Z).Value) Then
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveCell.Value = Sheets("Hoja2").Range("A" & Z).Value
ActiveCell.Offset(1, 0).Activate
End If
End If
Next
If (ActiveCell.Value = Empty) Then
Else
ActiveCell.Offset(-1, 0).Activate
End If
Loop
End Sub
Espero mi ayuda le sea de utilidad, si ud gusta me escribe un correo a donde le pueda enviar el archivo como lo hice para que vea su funcionamiento, esta macro si la adecua bien le debe funcionar de 10, a mi me funciono, recuerde que cualquier duda me puede consultar en mi perfil que con gusto le colaboro, POR FAVOR NO OLVIDAR PUNTUAR Y FINALIZAR LA PREGUNTA, que tenga un feliz día!
