MACRO para buscar datos de txt y enviarlo a excel

https://drive.google.com/file/d/1f5722GdzvD-3KSW2HU8iok4yg3ACC-h8/view?usp=sharing

En el enlace esta el archivo en el que hay que buscar

Buenas tardes necesito una macro que me permita buscar el nombre de la persona a partir de su numero de DNI

El archivo txt tiene el siguiente formato

1000180|BENITEZ, ROSALIA|8|BERO6124900|

100020|FARANO VDA DE VEGA, ROLANDA DOMINGA|9|FARO270200W|
Están separadas por línea vertical

En mi excel al ingresar el DNI en la celda A1

1000180

Quiero que en la celda "B1" me devuelva el nombre BENITEZ, ROSALIA en la "C1" 8 y en la "D1" BERO6124900

Espero su ayuda... Les voy a agradecer muchísimo

Respuesta
1

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

Vale, supongo que quieres que se corra la macro al escribir y dar ENTER o pasarte a la siguiente celda.

Cambie un poco el código rápido, pruébalo así y si te parece extraño o incomodo me dejas saber y mañana te hago uno más productivo que ya es tarde acá.

Substituye el código que te di antes por este y otra vez, ajusta la ruta.

Sub CreateReference(DNInum As String, DataRow As Integer)
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(DNInum, DataRow)
Application.DisplayAlerts = False
Sheets("TempDB").Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Sub FindDNI(DNInum As String, DataRow As Integer)
    Dim uF As Long
    Dim DNI As String
    Dim Rng As Range
    DNI = DNInum
    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(DataRow, 2).Value = Rng.Offset(0, 1).Value
                Cells(DataRow, 3).Value = Rng.Offset(0, 2).Value
                Cells(DataRow, 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

Ahora vas a tener que agregar un codigo nuevo, en el modulo de la hoja. Das click derecho a la pestaña de la hoja y le das click en "Ver codigo" y pegas lo siguiente:

Option Explicit
Public OldCell As String
Public NewCell As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim isect As Range
Set isect = Intersect(Target, Me.Range("$A:$A"))
If isect Is Nothing Then Exit Sub
If NewCell = "" Then NewCell = ActiveCell.Address
OldCell = NewCell
NewCell = ActiveCell.Address
Call CreateReference(Range(OldCell).Value, Range(OldCell).Row)
End Sub

Eso va a ejecutar la macro cada vez que escribas un DNI en la columna A y pases a la siguiente celda.

Repito, si te parece incomodo o raro la manera de trabajarlo, me avisas y mañana lo arreglamos que esto lo hice a lo loco.

Andy M

3 respuestas más de otros expertos

Respuesta
1

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

Respuesta
1

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

El problema es la cantidad de datos que tienes supongo que pasa de más de 1 millón de registros y también supongo que tienes una cantidad muy limitada de memoria así que por macros y con esa cantidad de registros va a estar en chino que alguien te de una respuesta y cuando por lo que comentas de que se te congela la PC ya es un problema de memoria e incluso de procesador, lo más probable es que necesites añadir más memoria y/o tener un procesador de doble o cuádruple núcleo, la otra es dividir la información en partes más manejables por ejemplo yo tengo un procesador de lo más simple atom, tengo menos de 1 gb de memoria ram y lo más que puedo trabajar con registros sin que se ponga lenta es más o menos 500,000 registros de hecho tu información la copie 4 veces para tener 405,000 registros y la macro funciono muy bien, otra cosa por la que se entorpezca tu maquina es que tus datos excedan la cantidad de filas que tiene excel al no saber que hacer las que sobran caes en un bucle tratando de mostrarte una pantalla de error que nunca saldrá por que agoto la memoria, otra alternativa es que en vez de excel uses una base de datos y entonces ya no tendrías problemas de congelamiento de pc

Respuesta

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

Reemplaza la ruta al archivo, que se me fue la ruta de mi compu. XD

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas