MACRO para buscar datos de txt y enviarlo a excel

H0la Rubén:

¿No sería más eficiente pasar tu txt a una planilla excel y realizar la búsqueda con un BUSCARV?

Lo digo, porque la forma que conozco de poder encontrar un dato en un TXT es con una búsqueda secuencial (quizá algún otro usuario conozca otra)

Si te parece importar los datos, la opción a utilizar es la siguiente

Si tienes dudas, me comentas.

S@lu2

Isaac el problema es que es solo uno de los txt que debo buscar al importar al Excel pesa muchísimo se cuelga aveces... Mi idea es unir todos los txt con un bat y luego con el Excel buscar el valor exacto en ese txt y que me devuelva los resultados

H0la Ruben:

Esto no es lo más hermoso que he hecho en mi vida (quizá James o Andy lo puedan hermosear), tampoco es completamente de mi autoría, ya que encontré gran parte del código en la web, pero al parecer funciona

Sub LoadFile(lngFila As Long) ' load entire file to string'
' from Siddharth Rout'
' http://stackoverflow.com/questions/20128115/'
    Dim MyData As String, strRuta As String, strRes As Variant
    Dim strBuscado As String, l1 As Long, l2 As Long, l3 As Long, l4 As Long
    strRuta = "C:\Users\Elisabeth\Desktop\Isaac\Varios\ruc.txt"
    Open strRuta For Binary As #1
    MyData = Space$(LOF(1)) ' sets buffer to Length Of File
    Get #1, , MyData ' fits exactly
    Close #1
    strBuscado = Range("A" & lngFila).Value & "|"
    l1 = InStr(1, MyData, strBuscado)
    l2 = InStr(l1 + Len(strBuscado), MyData, "|")
    l3 = InStr(l2 + 1, MyData, "|")
    l4 = InStr(l3 + 1, MyData, "|")
    strRes = Split(Mid(MyData, l1, l4 - l1), "|")
    Range("B" & lngFila).Value = strRes(1)
    Range("C" & lngFila).Value = strRes(2)
    Range("D" & lngFila).Value = strRes(3)
End Sub
'Esta es una alternativa con validaciones mínimas para llamar al procedimiento'
    If Target(1).Column = 1 Then
        LoadFile Target(1).Row
    End If
End Sub

Me comentas cómo te va con eso.

S@lu2

La primera macro trae el archivo texto a Excel, el segundo hace una búsqueda sobre el texto concatenado y una vez que lo encuentra hace una separación y los coloca en la celda B1, C1 y D1, si ni usas las primera macro entonces cambia el range("a4") por la celda donde inicien tus datos

Sub abrir_txt()
    ChDir "C:\Documents and Settings\Propietario\Mis documentos\Downloads"
    Workbooks.OpenText Filename:= _
        "C:\Documents and Settings\Propietario\Mis documentos\Downloads\ruc.txt", _
        Origin:=xlWindows, StartRow:=1
        With Range("a1")
            .Rows(1).Resize(3, 1).EntireRow.Insert
        End With
End Sub
Sub buscar_datos()
Set datos = Range("a4").CurrentRegion
With datos
    ID = Range("a1")
    Set busca = .Find(ID)
    fila = Trim(Range(busca.Address))
    separa = Split(fila, "|")
    Range("b1") = separa(1)
    Range("c1") = separa(2)
    Range("d1") = separa(3)
End With
Set datos = Nothing
End Sub

Voy a probarlo para ver si es lo que busco James bond

muy cerca de lo que quiero james bond , en la columna A iré colocando los valores que quiero buscar... pero sin importar los datos del txt en el excel 

el ejemplo solo pesa 5mb pero la base de datos que utilizare es de casi 200 mb y se me cuelga la pc

Los compañeros Isaac y James están en la ruta correcta, a mi no se me ocurre otra forma, es demasiado lo que tienes.

Grabe esta simulación usando el archivo que pasaste y haciéndolo como quieres, mira cuanto me tarde, y mi PC es bastante buena, demora de 2 a 3 segundos en encontrar el DNI:

Video demo

Mi PC tiene un Ryzen 5 1600x

Y 16GB de ram.

Supongo que en un sistema más lento pueda tardar más.

Esto es lo que necesito andy así mismo pero ir colocando valores a buscar en la columna A, es exactamente lo que busco, mi archivo original pesa 200 megas puedo alzarlo 

Hombre, pues te daré un consejo, yo no recomiendo Excel para manipular toda es info. Deberías empezar a considerar usar un motor de bases de datos y hacer consultas con SQL o algo más potente que simplemente VBA en una hoja de calculo con un TXT. Mi código es bastante simple y no se aleja de lo que te dice Isaac y James, solo que es más estético. Mi macro hace más o menos lo mismo que recomiendan ellos pero adaptado a tu solicitud.

Sub CreateReference()
Application.ScreenUpdating = False
Dim CrrtWS As Worksheet
Set CrrtWS = ActiveSheet
Dim TempDB As Worksheet
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "TempDB"
Set TempDB = ActiveSheet
    With TempDB.QueryTables.Add(Connection:="TEXT;C:\Users\andym\ruc.txt", _
        Destination:=Range("$A$1"))
        .Name = "ruc"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = "|"
        .TextFileColumnDataTypes = Array(1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
CrrtWS.Activate
Call FindDNI
Application.DisplayAlerts = False
Sheets("TempDB").Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Sub FindDNI()
    Dim DNI As String
    Dim Rng As Range
    DNI = Cells(1, 1).Value
    If Trim(DNI) <> "" Then
        With Sheets("TempDB").Range("A:A")
            Set Rng = .Find(What:=DNI, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                Cells(1, 2).Value = Rng.Offset(0, 1).Value
                Cells(1, 3).Value = Rng.Offset(0, 2).Value
                Cells(1, 4).Value = Rng.Offset(0, 3).Value
            Else
                MsgBox "No se encontro ese DNI", vbExclamation, "No existe..."
            End If
        End With
    End If
End Sub

Son dos macros.

1- Parsea la información en Excel

2- Busca el DNI

Solo debes ejecutar la 1. y esa llama a la 2.

Lo que hace es crear una hoja Temporal, parsea el TXT en esa hoja, busca el DNI y luego la borra. Si sabes un poco de VBA, adáptalo para que trabaje EXACTAMENTE como lo quieres, y no olvides cambiar la ruta del archivo txt.

NOTA: Yo la usaría en mi PC, no me molestaría esperar un par de segundos para cada consulta, pero ya en otra PC más lenta, me lo pensaría eh.

Andy M

Voy a probarlo mañana andy muchas gracias... 

Hora lo probé funciona no tarda tanto... No eran 200 megas solo 59 megas y no tarda... Como hago para me devuelva los valores si voy colocando dni en la columna A y me devuelva los valores en las demás columnas 

quiero poner varios valores en la columna y que me devuelva los datos como en la primera fila