Exportar a fichero texto
Hola valedor, espero que tengas solución para este tema pues con la macro que hecho me he quedado trabado en este punto.
Tengo imaginate cuatro columnas con valores que vienen a ser números mi problema consiste en que quiero exportar esos datos a formato TXT y las columnas separadas con punto y coma (;) y ademas para complicar las cosas con un ancho especifico en las columnas.
Es decir teniendo:
col a col b col c
1 2 88
33 15 1199
Que me salga un fichero texto de la siguiente forma:
01;000002;0088
33;000015;1199
Me da igual que vayan 0 (ceros) delante o espacios, pero que sea en esa cantidad exacta (dos para la primera, seis para la segunda ...)
Evidentemente hay más columnas pero con que me digas el truco para estas, lo demás me lo dejas chupado
Gracias de antemano JMC
Tengo imaginate cuatro columnas con valores que vienen a ser números mi problema consiste en que quiero exportar esos datos a formato TXT y las columnas separadas con punto y coma (;) y ademas para complicar las cosas con un ancho especifico en las columnas.
Es decir teniendo:
col a col b col c
1 2 88
33 15 1199
Que me salga un fichero texto de la siguiente forma:
01;000002;0088
33;000015;1199
Me da igual que vayan 0 (ceros) delante o espacios, pero que sea en esa cantidad exacta (dos para la primera, seis para la segunda ...)
Evidentemente hay más columnas pero con que me digas el truco para estas, lo demás me lo dejas chupado
Gracias de antemano JMC
1 respuesta
Respuesta de valedor
1
Solo tienes que hacer lo siguiente
Evaluar en que columna esta
Medir el numero de caracteres
Completar el resto con ceros o espacios
Prueba la siguiente macro, introduciendo valores en alguna de las tres primeras columnas, por ejemplo
A1 = 1
B1 = 2
C1 = 88
Has que sea la celda activa cada una y en cada una ejecuta la macro, veras como le acompleta los ceros
Option Explicit
Public Sub Completar()
Dim strCampo As String
Select Case ActiveCell.Column
Case 1
strCampo = String(2 - Len(ActiveCell.Value), "0") & ActiveCell.Value
Case 2
strCampo = String(6 - Len(ActiveCell.Value), "0") & ActiveCell.Value
Case 3
strCampo = String(4 - Len(ActiveCell.Value), "0") & ActiveCell.Value
End Select
ActiveCell.NumberFormat = "@"
ActiveCell.Value = strCampo
End Sub
Evaluar en que columna esta
Medir el numero de caracteres
Completar el resto con ceros o espacios
Prueba la siguiente macro, introduciendo valores en alguna de las tres primeras columnas, por ejemplo
A1 = 1
B1 = 2
C1 = 88
Has que sea la celda activa cada una y en cada una ejecuta la macro, veras como le acompleta los ceros
Option Explicit
Public Sub Completar()
Dim strCampo As String
Select Case ActiveCell.Column
Case 1
strCampo = String(2 - Len(ActiveCell.Value), "0") & ActiveCell.Value
Case 2
strCampo = String(6 - Len(ActiveCell.Value), "0") & ActiveCell.Value
Case 3
strCampo = String(4 - Len(ActiveCell.Value), "0") & ActiveCell.Value
End Select
ActiveCell.NumberFormat = "@"
ActiveCell.Value = strCampo
End Sub
Correcto como siempre, pero ahora me falta el paso principal exportar el resultado a un fichero en formato texto pero ahí viene la dificultad con las celdas separadas con (;) un punto y coma, (las opciones que tengo es delimitado por espacios o por tabulador)
Eso no fue lo que originalmente preguntaste, pero esta macro te hace el trabajo:
NOTAS: el cursor debe de estar en cualquier parte de tus datos, falta que le agregues lo de tu primer pregunta, tu tarea es esto y adaptarlo a tus necesidades...
Option Explicit
Public Sub ExportarArchivo()
Dim strRuta As String
Dim rDatos As Range
Dim strFila As String
Dim strContenido As String
Dim Libre As Integer
Dim co1 As Long, co2 As Integer
strRuta = ThisWorkbook.Path & "\Datos.txt"
Set rDatos = ActiveCell.CurrentRegion
For co1 = 2 To rDatos.Rows.Count
strFila = ""
For co2 = 1 To rDatos.Columns.Count
If co2 = 1 Then
strFila = rDatos.Cells(co1, co2).Value
Else
strFila = strFila & ";" & rDatos.Cells(co1, co2).Value
End If
Next co2
strContenido = strContenido & strFila & vbCrLf
Next co1
If Len(Dir(strRuta)) > 0 Then
Kill strRuta
End If
Libre = FreeFile
Open strRuta For Binary As #Libre
Put #Libre, , strContenido
Close #Libre
End Sub
NOTAS: el cursor debe de estar en cualquier parte de tus datos, falta que le agregues lo de tu primer pregunta, tu tarea es esto y adaptarlo a tus necesidades...
Option Explicit
Public Sub ExportarArchivo()
Dim strRuta As String
Dim rDatos As Range
Dim strFila As String
Dim strContenido As String
Dim Libre As Integer
Dim co1 As Long, co2 As Integer
strRuta = ThisWorkbook.Path & "\Datos.txt"
Set rDatos = ActiveCell.CurrentRegion
For co1 = 2 To rDatos.Rows.Count
strFila = ""
For co2 = 1 To rDatos.Columns.Count
If co2 = 1 Then
strFila = rDatos.Cells(co1, co2).Value
Else
strFila = strFila & ";" & rDatos.Cells(co1, co2).Value
End If
Next co2
strContenido = strContenido & strFila & vbCrLf
Next co1
If Len(Dir(strRuta)) > 0 Then
Kill strRuta
End If
Libre = FreeFile
Open strRuta For Binary As #Libre
Put #Libre, , strContenido
Close #Libre
End Sub
