Macro que extraiga planilla de texto a excel

Estimado
Te cuento todos los días se generar planilla de venats en formato texto las cuales son como 80 diarias y las tengo que pasar a excel a mano una a una.
Por lo tanto necesito desarrollar una macro que realize este trabajo y no tengo idea de macros.
Las caractesristica de los archivos de texto son separados por coma y el largo va desde A a AA ya que la otra complejidad es que debe rescatar el nombre de archivo de texto y colocarlo en la planilla excel en la columna AB, esto es por cada planilla procesada.
Te envío muestra de los datos que contiene
0,"13204888","6","N","FLOR","","MUNOZ","QUINTANILLA","","F","C","","","","","","","","","N","","9044"
4,"13204888","C","ISABEL RIQUELME","267","","","",275,2453,"","","13204888","9044"
1,"13204888","6","N","FLOR","","MUNOZ","QUINTANILLA","","F","C","",0,0,"","","","","13204888","N","","9044"
5,"13204888","C","ISABEL RIQUELME","267","","","", 275,2453,"","","","9044"
7,106,10839,18456,"13204888", 0,"9044","",""
8,"13204888","1","CHL", 9,76282969,"V","","","","","", 18456,"","N","","","","9044","", 106,"","","","","","2500",""
9,"13204888","1","CHL", 61,581807,"V","","","","","", 18456,"","N", 9,76282969,"","9044","", 106,""
11,"13204888","1","CHL", 61,581807,"V","","","","","", 18456,"","N","","","","9044","", 106,""
De antemano gracias por tu ayuda
Atentamente
G.P.

1 respuesta

Respuesta
1
Observando la data, veo que esta separada por comas (,). En Excel 2007 existe la utilidad, "separar por columnas"
Abres el archivo txt copias todo el contenido en la Columna A, luego seleccionas toda esa columna, presionas la pestaña "Datos" y el botón "texto en columnas", se abrirá el asistente, debes pinchar opción "delimitado" y botón seguir
en el paso 2 te preguntara por los separadores de la data, selecciona Tabulación y Coma y listo te pondrá cada dato individualmente en cada columna
bye
Estimado,
Es lo que hago todo los días pero necesito automatizar este extracción con una macro, para realizarlo más rapido, ya que me demoro como una hora en preparar dichas planillas.
Esperando que halla quedado más claro.
Atentamente
G.P.
Quedo algo largo pero hace lo que deseas
El macro se llama pasar
Inserta un modulo nuevo en tu proyecto y en el copia este código
Option Explicit
Private Const MAX_PATH = 64
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
        dwFileAttributes As Long
        ftCreationTime As FILETIME
        ftLastAccessTime As FILETIME
        ftLastWriteTime As FILETIME
        nFileSizeHigh As Long
        nFileSizeLow As Long
        dwReserved0 As Long
        dwReserved1 As Long
        cFileName As String * MAX_PATH
        cAlternate As String * 14
End Type
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFind As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private TotSize As Long
Private NumSubdirs As Long
Private NumArxius As Long
Public TA As Long
Const MiDir As String = "C:\ARCHIVOS\"
Dim MATRIZ() As String
Dim NL As String
Sub pasar()
Dim i As Integer
On Error GoTo Err
ChDir MiDir
inf MiDir
If TA = 0 Then MsgBox "No se encontraron archivos en carpeta   " & MiDir, vbCritical: NL = "": Exit Sub
If TA > ActiveWorkbook.Sheets.Count Then MsgBox "El total de Archivos TXT  supera al total de hojas disponibles en el libro actual", vbCritical: NL = "": Exit Sub
MATRIZ = Split(NL, "#")
Application.ScreenUpdating = False
For i = LBound(MATRIZ) + 1 To UBound(MATRIZ) - 1
     Call texto(i, MiDir & MATRIZ(i), MATRIZ(i))
DoEvents
Next
Err:  If Err.Number = 76 Then MsgBox "No se encontro la carpeta  " & MiDir
NL = ""
Erase MATRIZ
Application.ScreenUpdating = True
MsgBox "Terminado"
End Sub
Sub texto(hoja As Integer, ruta As String, archivo As String)
    Sheets(hoja).Select
    Range("A1").Select
      With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & ruta, Destination:=Range("$A$1"))
        .Name = archivo
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub
Private Function inf(miPath As String) As Long
    Dim atribarx As Long, TotSize As Long
    Dim valor1 As Long, valor2 As Long
    Dim InfoTd As WIN32_FIND_DATA
    Dim NomArxiu As String
    On Error Resume Next
    If Right(miPath, 1) <> "\" Then miPath = miPath & "\"
    TotSize = 0
    NumSubdirs = 0
    NumArxius = 0
    valor1 = 0
    valor2 = True
    valor1 = FindFirstFile(miPath & "*.*", InfoTd)
    Do
        NomArxiu = InfoTd.cFileName
        atribarx = InfoTd.dwFileAttributes
        If Left(NomArxiu, 1) <> "." Then
            If atribarx And FILE_ATTRIBUTE_DIRECTORY Then
                NumSubdirs = NumSubdirs + 1
            Else
                NumArxius = NumArxius + 1
            End If
        End If
        valor2 = FindNextFile(valor1, InfoTd)
    If valor2 > 0 Then NL = (NL & InfoTd.cFileName & "#")
    Loop Until valor2 = 0
    FindClose (valor1)
    DoEvents
    TA = NumArxius
    DoEvents
    DoEvents
    TotSize = 0
    NumSubdirs = 0
    NumArxius = 0
End Function
Este macro tiene como directorio C:\ARCHIVOS declarado como constante debes modificar esa linea con el path de la carpeta en donde están tus archivos txt que deseas pasar a Excel
desde Excel lo llamas con teclas ALT + F8 seleccionas el nombre Pasar y listo
bye
Estimado,
gracias por la respuesta, necesito saber ahora como la integro a una macro de excel, tengo excel 97.
Puedes indicar paso a paso
De antemano gracias
Atentamente
G.P.
¿97?... ¿O 2007?.
Bueno, el tema es el siguiente graba una macro cualquiera.
Luego presionas ALT + F8 selecionas el macro qu acabas de grabar y pinchas el boton modificar
se te abrira el editor de Vbasic
reemplaza todo el contenido de esa ventana por todo el codigo que te adjunte antes
luego grabas y corres el macro "pasar"
Gracias, por tu respuesta, pero necesito sobre lo mismo lo siguiente :
Que todas las planillas queden en una sola hoja y poder recuperar el nombre de cada una de las planillas de texto y registrarla al lado de los datos en la Columna AB.
De antemano Gracias
Atentamente
G.P.
Hiciste una pregunta y en base a eso he respondido, si te funciona la respuesta, favor cerrar la pregunta, si tienes otra pregunta abres otra pregunta

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas