Pasar datos de celdas concretas a posiciones concretas de ficheros de texto
Tengo un problema que resolver urgentemente, y que al no tener ni idea de Excel no sé cómo. Supongo que a alguno de los grandes expertos que andan por aquí les resultará incluso fácil. A mí, y a más personas nos harían un gran favor.
Me dedico a un ámbito concreto de la medicina. Tengo una carpeta con ficheros con datos de enfermos, estos datos están en formato texto, .TXT y tienen como nombre el nombre del enfermo.
Me remiten diariamente un fichero en excel que contiene entre otros datos los nombres de los enfermos en la columna D, y medicación en la columna H.
Necesitaría que el problema se resolviera con una macro en excel que pudiera ejecutar mediante un botón o similar, como alguna que he visto a un compañero, si es posible.
Debe hacer lo siguiente: Recorrer la columna de los nombres de enfermos (D), y si ya existe en mi carpeta de Enfermos, que no haga nada y pase al siguiente, pero si no existe en la carpeta, debe coger el fichero de texto Enfermo-tipo.txt e insertar en la línea 5 el nombre del enfermo, en la 11 la medicación, y posteriormente salvarlo en esta carpeta con el nombre del enfermo.
Nota importante: Por lo que se refiere a la Ley de Protección de Datos y el Derecho a la Intimidad, lo que pongo son ejemplos y en ningún caso son datos reales de ninguno de los enfermos.
Te anexo la macro.
Realiza los siguientes ajustes en la macro:
Cambia "C:\trabajo\Enfermos\" por la carpeta donde tienes los archivos de enfermos
Cambia "Enfermo tipo.txt", por el nombre de archivo tipo. Nota: este archivo deberá estar también en la misma carpeta de Enfermos.
Ejecuta la macro sobre la hoja de excel, al final tendrás en la carpeta de enfermos los nuevos ficheros.
Sub Crear_ficheros_Txt()
'Por Dante Amor
'
ruta = "C:\trabajo\Enfermos\"
nomb = "Enfermo tipo.txt"
'
If Dir(ruta & nomb) = "" Then
MsgBox "Falta el archivo 'Enfermo tipo.txt'"
Exit Sub
End If
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
Set h1 = l1.ActiveSheet
For i = 2 To h1.Range("D" & Rows.Count).End(xlUp).Row
arch = h1.Cells(i, "D").Value
medi = h1.Cells(i, "H").Value
If Dir(ruta & arch & ".txt") = "" Then
Workbooks.OpenText _
Filename:=nomb, _
Origin:=xlWindows, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlNone, _
ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 2), _
TrailingMinusNumbers:=True
Set l2 = ActiveWorkbook
Set h2 = l2.Sheets(1)
h2.Range("A5").Value = arch
h2.Range("A11").Value = medi
l2.SaveAs _
Filename:=ruta & arch & ".txt", _
FileFormat:=xlUnicodeText, CreateBackup:=False
l2.Close
End If
Next
'
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Fin Creación de Ficheros"
End Sub'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. '.[Avísame cualquier duda
[
'
.
Ante todo, un millón de gracias por su trabajo altruista y su rapidez en responderme.
Hice lo que me indicó, pero se me queda parado en ésto. Le cambié el nombre al directorio por el mío C:\Users\ALFONSO\Desktop\Enfermos\ , y todo está en la misma carpeta. El nombre del fichero para insertar los datos es Enfermo tipo.txt
Le adjunto imagen. No quisiera molestarle en demasía, pero es que no tengo ni idea de Excel y usted es el único que se ha dignado a responderme con ayuda de veras. Gracias de nuevo sr. Dante.
Buenas, conseguí reparar el error, salvando un fichero y grabando la macro. Me ha quedado así:
Sub Crear_ficheros_Txt()
'Por Dante Amor
'
ruta = "C:\Users\ALFONSO\Desktop\Enfermos\"
nomb = "Enfermo tipo.txt"
'
If Dir(ruta & nomb) = "" Then
MsgBox "Falta el archivo 'Enfermo tipo.txt'"
Exit Sub
End If
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
Set h1 = l1.ActiveSheet
For i = 2 To h1.Range("D" & Rows.Count).End(xlUp).Row
arch = h1.Cells(i, "D").Value
medi = h1.Cells(i, "H").Value
If Dir(ruta & arch & ".txt") = "" Then
Workbooks.OpenText Filename:= _
"C:\Users\ALFONSO\Desktop\Enfermos\Enfermo tipo.txt" _
, Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlNone, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma _
:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 2), _
TrailingMinusNumbers:=True
Set l2 = ActiveWorkbook
Set h2 = l2.Sheets(1)
h2.Range("A5").Value = arch
h2.Range("A11").Value = medi
l2.SaveAs _
Filename:=ruta & arch & ".txt", _
FileFormat:=xlUnicodeText, CreateBackup:=False
l2.Close
End If
Next
'
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Fin Creación de Ficheros"
End Sub
Nota:
La verdad es que no he deducido dónde estaba el eeror, pero ahora me funciona, salvo en que en los ficheros de resultado me introduce unas comillas en los datos que inserta en la medicación y que no me respeta la acentuación de algunos de los nombres...
Si vd. pudiera indicarme algo al respecto, se lo agradecería, y se lo digo porque es el único con el que cuento, y necesito resolver este problema que tengo cuanto antes. Ya le di mi máxima puntuación antes y si tuviera que volver a hacerlo lo haría, porque la gente no ayuda a nadie desinteresadamente y es dificil encontrar a alguien como vd. Un millón de gracias.
Y me quedan así...:
Hospital:
Hospital General
------------------
Datos del enfermo:
Luísa Márquez <-- Sin embargo el nombre es acentuado y está perfecto
Diagn├│stico actual: <-- Aquí ha sustituido el texto acentuado
En estudio
Casos anteriores:
"Leucemia, prostatitis aguda." <-- Aquí han aparecido comillas
Medicaci├│n <-- Aquí ha sustituido el texto acentuado....
Mioxam
Ubicaci├│n:
UCI
Fecha de ingreso:
20-03-018
Intervenciones:
Seg├║n acta de quir├│fano.
Terapia aplicada:
Seg├║n informe.
Prueba con la siguiente y me comentas:
Sub Crear_ficheros_Txt()
'Por Dante Amor
'
ruta = "C:\trabajo\Enfermos\"
nomb = "Enfermo tipo.txt"
'
If Dir(ruta & nomb) = "" Then
MsgBox "Falta el archivo 'Enfermo tipo.txt'"
Exit Sub
End If
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
Set h1 = l1.ActiveSheet
For i = 2 To h1.Range("D" & Rows.Count).End(xlUp).Row
arch = h1.Cells(i, "D").Value
medi = h1.Cells(i, "H").Value
If Dir(ruta & arch & ".txt") = "" Then
Workbooks.OpenText _
Filename:=ruta & nomb, _
Origin:=xlWindows, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlNone, _
ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 2), _
TrailingMinusNumbers:=True
Set l2 = ActiveWorkbook
Set h2 = l2.Sheets(1)
h2.Range("A5").Value = arch
h2.Range("A11").Value = medi
l2.SaveAs _
Filename:=ruta & arch & ".txt", _
FileFormat:=xlTextPrinter, CreateBackup:=False
l2.Close
End If
Next
'
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Fin Creación de Ficheros"
End Subcambia la ruta por la tuya.
Buenas Dante. Sigue descomponiendo las palabras acentuadas.
Pregunto, ¿No habría forma de sustituir las comillas por un espacio en blanco, con ello y guardando en el formato anterior me valdría, creo yo.
Gracias.
¿Modificaste algo de la macro?
En mi versión de excel 2007 me funciona bien.
No, no modifiqué sólo dónde mi directorio.
También uso Office 2007.
Bueno, da igual, haré una sustitución de caracteres. la grabo con la grabadora de macros y la pongo al final, a ver que tal me queda.
No te molesto más. Ya hiciste bastante.
Gracias por tu ayuda.
Revisa el siguiente artículo:
https://www.gerencie.com/imprimir-plantilla-de-excel-con-una-base-de-nombres.html
Ahí explico cómo generar varios archivos en base a una planilla
2 respuestas más de otros expertos
Me queda una duda, pero es fácil resolver tu problema, solo que lo estas enfocando mal.
La duda es si la fecha de ingreso quieres que sea la que "default" de tu enfermo tipo.
Por otro lado, no necesitas insertar, en un txt ya creado, las filas, solo tienes que insertar en un nuevo archivo todas las líneas de texto, sean recogidas del excel o fijas, y guardarlas (según entiendo yo) con el nombre del enfermo (mal uso guardar un fichero por nombre de una persona, porque tenemos el defecto de estar repetidos muchas veces) en la carpeta donde tenga que ser.
Si no sabes como hacerlo me indicas y te preparo una demo para enfocar el asunto.
Gracias por su respuesta.
No creo estar enfocándolo mal. No tengo que cambiar la fecha. El fichero que le he puesto no es real, ya que no voy a exponer datos de enfermos públicamente, ya se lo dije en la pregunta, sólo quiero insertar datos que tendré en un fichero de excel en las filas D y H en las posiciones que le indico en ficheros de texto, filas 5 y 11 respectivamente, tomando como base uno tipo con otra información (que será diferente porque el fichero tipo cambiará periódicamente de contenido), excepto en esas filas, y guardarlo no un nombre que estará en la fila D.
NO habrá ficheros repetidos, porque como indico, si el fichero existe no se deberán escribir las líneas ni se creará otro fichero con ese nombre.
Y no , no sé cómo hacerlo, también lo digo en mi pregunta. No tengo ni idea de Excel, lo admito.
Aún así y todo, gracias por su ayuda.
La respuesta de Dante hace exactamente lo que buscas.
Cuando me refería que lo estás enfocando mal me refiero a recoger los datos de un txt, es más sencillo que esos datos estén en un excel, aunque al final la respuesta sea un txt.
Por ficheros repetidos me refiero a que si usas el nombre de los pacientes y tienes dos pacientes con el mismo nombre, pues obviamente no repetirás el fichero ya que tu macro así lo hace, pero uno de ellos no tendrá txt.
Es posible esto te aporte algo más o de alguna idea extra