Jump to content

Macro para pasar datos Excel a TXT


Recommended Posts

  • 2 weeks later...

Copia la macro y el resultado lo pondrá en la Hoja2... Saludos

Sub genera_txt()
    Set datos = Worksheets("Hoja1")
    Sheets("hoja2").Select
    Dim cadena As String
    Range("a27:a5000").ClearComments
    rd = 2
    rs = 27
    xc = Chr(34)
    Do While datos.Cells(rd, 1) <> ""
        cadena = xc & Left(datos.Cells(rd, 3), Len(datos.Cells(rd, 3)) - 6) & xc & "," & xc
        For i = 6 To 10
            cadena = cadena & datos.Cells(rd, i)
        Next
        cadena = cadena & xc & "," & xc
        For i = 11 To 56
            cadena = cadena & datos.Cells(rd, i)
        Next
        cadena = cadena & xc & "," & xc & datos.Cells(rd, 1) & xc
        Cells(rs, 1) = cadena
        rs = rs + 1
        rd = rd + 1
    Loop
End Sub
 

Link to comment
Share on other sites

Observé un pequeño error, espero ya esté bien.

Sub genera_txt()
    Set datos = Worksheets("Hoja1")
    Sheets("hoja2").Select
    Dim cadena As String
    Range("a27:a5000").ClearComments
    rd = 2
    rs = 27
    xc = Chr(34)
    Do While datos.Cells(rd, 1) <> ""
        cadena = xc & Left(datos.Cells(rd, 3), Len(datos.Cells(rd, 3)) - 6) & xc & "," & xc
        For i = 7 To 11
            cadena = cadena & datos.Cells(rd, i)
        Next
        cadena = cadena & xc & "," & xc
        For i = 12 To 56
            cadena = cadena & datos.Cells(rd, i)
        Next
        cadena = cadena & xc & "," & xc & datos.Cells(rd, 1) & xc
        Cells(rs, 1) = cadena
        rs = rs + 1
        rd = rd + 1
    Loop
End Sub
 

Link to comment
Share on other sites

Muchas Gracias Janlui.

Funciona perfecto, veras que he añadido a la macro una última línea que es la que crea el fichero final TXT en una ubicación concreta. Lo que no se es porque una vez generado el TXT la última parte la vuelve a entrecomillar (en la hoja 5 del fichero que adjunto veras un pantallazo del TXT que genera)

Repito, muchas gracias por la ayuda

Saludos

 

 

 

Ejemplo3.xlsm

Link to comment
Share on other sites

- Ya no se utiliza la Hoja2.

- El resultado lo pone dentro de la carpeta donde se encuentra tu archivo excel en SALIDA.TXT

- Al ejecutarlo no debe estar abierto el archivo SALIDA.TXT

Espero que esto ya se encuentre solucionado

Sub salida_txt()
    Application.ScreenUpdating = False
    Set datos = Worksheets("Hoja1")
    Sheets("hoja1").Select
    arch = ActiveWorkbook.Path & "\salida.txt"
    Dim cadena As String
    Open arch For Output As #1
    
    For i = 1 To 5
        Print #1, "Pregunta " & i
        Print #1, ">a"
        Print #1, ">b"
        Print #1, ">c"
        Print #1, ">d"
    Next
    Print #1, String(40, "*")
    rd = 2
    xc = Chr(34)
    Do While Cells(rd, 1) <> ""
        cadena = xc & Left(Cells(rd, 3), Len(Cells(rd, 3)) - 6) & xc & "," & xc
        For i = 7 To 11
            cadena = cadena & Cells(rd, i)
        Next
        cadena = cadena & xc & "," & xc
        For i = 12 To 56
            cadena = cadena & Cells(rd, i)
        Next
        cadena = cadena & xc & "," & xc & datos.Cells(rd, 1) & xc
        Print #1, cadena
        rd = rd + 1
    Loop
    Close #1
    Application.ScreenUpdating = True
    MsgBox "Reporte Generado en: " & arch
    Range("a1").Select
End Sub
 

Link to comment
Share on other sites

Janlui una cosa más.

La primera parte del txt se genera con:

  Open arch For Output As #1
        For i = 1 To 5
        Print #1, "Pregunta " & i
        Print #1, ">a"
        Print #1, ">b"
        Print #1, ">c"
        Print #1, ">d"
    Next
    Print #1, String(40, "*")
    rd = 2
    xc = Chr(34)

 

Esa parte del archivo mas o menos es fija, lo único que es susceptible de cambios, tanto en el contenido como en el número de preguntas. He pensado en hacer un libro (“Preguntas”) con los archivos que servirá para el mantenimiento de los posibles cambios que se puedan tener. En la macro que has enviado he sustituido lo que creo que es la parte que corresponde con lo que no hay que concatenar,

  Open arch For Output As #1
        For i = 1 To 5
        Print #1, "Pregunta " & i
        Print #1, ">a"
        Print #1, ">b"
        Print #1, ">c"
        Print #1, ">d"
    Next
    Print #1, String(40, "*")
    rd = 2
    xc = Chr(34)

 

con un copiar un rango de una hoja del mismo libro (“Preguntas”) y pegarlo en la hoja activa (“Hoja1”),  a partir de ahí que coloque los datos concatenados y ya se genere el txt.:

 

    Sheets("Pregunta").Select

    Range("A1:A25").Select

    Selection.Copy

    Sheets("Hoja1").Select

    Range("A1").Select

    ActiveSheet.Paste

 

Quedaría así, aunque no me funciona, da error en la línea amarilla, y no sé cómo solucionarlo

Sub salida_txt()

    Application.ScreenUpdating = False

    Set datos = Worksheets("Hoja1")

    rd = 2

    rs = 58

    xc = Chr(34)

    Sheets("hoja1").Select

    arch = ActiveWorkbook.Path & "\salida.txt"

    Dim cadena As String

    Sheets("Preguntas").Select

    Range("A1:A58").Select

    Selection.Copy

    Sheets("Hoja1").Select

    Range("A1").Select

    ActiveSheet.Paste

    Do While Cells(rd, 1) <> ""

        cadena = xc & Left(Cells(rd, 3), Len(Cells(rd, 3)) - 6) & xc & "," & xc

        For i = 7 To 11

            cadena = cadena & Cells(rd, i)

        Next

        cadena = cadena & xc & "," & xc

        For i = 12 To 58

            cadena = cadena & Cells(rd, i)

        Next

        cadena = cadena & xc & "," & xc & datos.Cells(rd, 1) & xc

        Print #1, cadena

        rd = rd + 1

    Loop

    Close #1

    Application.ScreenUpdating = True

    MsgBox "Reporte Generado en: " & arch

    Range("a1").Select

End Sub

 

 

No se si me he armado mas lio del que ya tenia

 

Saludos

Link to comment
Share on other sites

Como te comentaba la parte que va concatenada, la que se encuentra en la Hoja1, la macro lo hace perfecto.

 

Te decia  en el mensaje y parece que lo vemos así los dos, puesto que la parte de las preguntas y respuestas es mas o menos fija, aunque es susceptible de cambios, el ponerla en una hoja a parte por ejemplo "Preguntas" con lo que  se podrian mantener mas facilmente los cambios, incluso  con hacer un corta pega seria suficiente.

Saludos

Ejemplo3.xlsm

Link to comment
Share on other sites

Que corto y rapido que lo has hecho.  Esto:

Do While preg.Cells(rp, 1) <> ""
        Print #1, preg.Cells(rp, 1)
        rp = rp + 1
    Loop

Me imagino que esto,  el corta pega que comentaba yo. Ya medio entiendo la macro ;)

De esta manera, al ir en una aparte es mas sencillo hacer cualquier  modificación en las preguntas que son las susceptibles de hacer modificaciones, la otra parte no se puede modificar.

Muy amable y muchas gracias por la ayuda.

Saludos

Link to comment
Share on other sites

Hola

Eso que me dices para mi ya es ciencia ficción. De momento para lo que necesito con esto ya tengo bastante. Cuando aprenda un poco ya ire intentando cosas mas complicadas. No te creas que comprender las macros que me habeis ayudado tu, Antoni y Gerson Pineda, me esta costando lo suyo. De momento mis conocimientos son muy basicos y tengo que estar constantemente mirando manuales y aun asi me cuesta.

 

Saludos

Link to comment
Share on other sites

En 22/9/2021 at 17:35 , Janlui dijo:

Observo que el cuerpo de las preguntas no corresponde al cuerpo de la información obtenida.

Te lo comento porque se podría obtener el resultado de la encuesta por cada pregunta, tiempos de respuetsa, opinion segmentado por sexo,etc.

Hola, de nuevo, te envio el archivo y un pantallazo, veras que a la macro que me eviaste le he hecho unas pequeñas modicifaciones, aunque son pequeñas me cuesta mucho. Es necesario que en el TXT el formato fecha sea "dd/mm/aaaa hh:mm"

imagen.thumb.png.4088712f06e4033555d542a618cb7d9d.png

Ejemplo3.xlsm

Link to comment
Share on other sites

Hace 8 horas, Janlui dijo:

Janlui, entiendo que lo que hace la macro es añadirle un cero a la antepenúltima posición?

'xh = texto(Hour(a), "00")  Esto es otra manera de hacerlo?

En el boton "run" la macro asociada es la "Macro1", como asocias esto con la generación del TXT?, debe de estar pero no lo veo

Link to comment
Share on other sites

  • Crear macros Excel

  • Posts

    • Muchas gracias por todo voy analizar tus recomendaciones, Dios te bendiga...  
    • Hola @Janluicomo seria en vba?
    • Tu información la graficaría en función a la actividad por día
    • Hola, Observo que el planteamiento o tu formulación está mal. 1. Todos los dias deberán sumar 24:00 horas excepto el domingo que unicamente trae información hasta las 6 de la mañana. 2. Lo que observo es que esas 24:00 los componen diferentes cortes de tiempo (Columna A) 3. Creo que lo que deberás graficar son los # de casos o cuantos eventos suceden cada dia. 4. Existen algunos días que rebasan las 24 horas, por eso agregué  el formato de días. Este es el resumen. Ya me comentarás  
    • Abre un Modulo ( Alf + F11) y copia la macro, el Archivo TXT colocalo en la misma carpeta donde se encuentyre tu archivo excel. Si observas la macro, procesará el archivo 1.TXT Sub opentxt()     Application.ScreenUpdating = False     Application.DisplayAlerts = False     Range("a1:b1000").ClearContents     Dim myfile As Variant, cad As String, fila As Long     ruta = ActiveWorkbook.Path     ChDir ruta     myfile = "1.txt"     fname = Dir(myfile)     If fname = "" Then         MsgBox "No existe archivo en esta carpeta"         Exit Sub     End If          Open myfile For Input As #1     fila = 1     Cells.Clear     While Not EOF(1)         Line Input #1, cad         Cells(fila, 2) = cad         fila = fila + 1     Wend     Close #1          Application.ScreenUpdating = True     Application.DisplayAlerts = True End Sub  
  • Recently Browsing

    • No registered users viewing this page.
×
×
  • Create New...

Important Information

Privacy Policy