Excel - ME AYUDAN CON ESTA MACRO PARA BUSCAR

 
Vista:

ME AYUDAN CON ESTA MACRO PARA BUSCAR

Publicado por ruben dario (1 intervención) el 20/01/2020 14:35:46
Tengo un problema con esta macro , al buscar no me devuelve el valor exacto se confunde con numeros similares

por ejemplo si busco el valor 6005900

me devuelve alguno que contenga ese valor por ejemplo MIAM6005900 , necesito que busque especificamente el valor y que ignore los que coinciden con el texto


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Sub LoadFile(): On Error Resume Next ' load entire file to string'
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
'--
Application.ScreenUpdating = False
'strRuta = ThisWorkbook.Path & "\TotalRUC.TXT"
strRuta = "C:\TotalRUC.TXT"
Open strRuta For Binary As #1
MyData = Space$(LOF(1)) ' sets buffer to Length Of File
Get #1, , MyData ' fits exactly
Close #1
For x = 2 To Range("A" & Rows.Count).End(xlUp).Row - 0
If Trim(Range("A" & x)) <> "" Then
strBuscado = Range("A" & x) & "|"
l1 = InStr(1, MyData, strBuscado)
If l1 = 0 Then
Range("B" & x) = "NO ES CONTRIBUYENTE"
Else
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" & x) = strRes(1)
Range("C" & x) = strRes(2)
Range("D" & x) = strRes(3)
strnom = Split(strRes(1), ",")
Range("E" & x) = strnom(1)
Range("F" & x) = strnom(0)
End If
End If
Next
Cells.Replace What:="Ñ", Replacement:="Ñ"
End Sub

ADJUNTO ARCHIVOS
https://send.firefox.com/download/346582f131c821d9/#9NuTCK6kSjzV92aYo42aag
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Antoni Masana
Val: 4.908
Oro
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

ME AYUDAN CON ESTA MACRO PARA BUSCAR

Publicado por Antoni Masana (2463 intervenciones) el 20/01/2020 19:49:27
A parte de así se lee mejor el código, no se que haces, desconozco la estructura de tus datos, del libro y del fichero de texto, sobre todo de ese último.

Soluciones hay muchas, la principal es leer el fichero de texto separando registros y campos, puedes hacerlo sobre una tabla o una hoja temporal y después solo debes buscar por el campo identificativo.

Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
Imágen de perfil de Antoni Masana
Val: 4.908
Oro
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

ME AYUDAN CON ESTA MACRO PARA BUSCAR

Publicado por Antoni Masana (2463 intervenciones) el 21/01/2020 08:33:43
No me había fijado que habías adjuntado los datos, error mio.

Visto el fichero de texto te puedo decir que el campo por el que buscar esta delimitado por la derecha con la barra "|" y por la izquierda con el carácter LF o sea chr$(10).

Para llegar a esta conclusion he usara este pequeño código
1
2
3
4
5
6
7
8
9
10
11
12
13
Sub pp()
    Dim reg As String, a As Integer
 
    strRuta = "C:\Download\Send-Archive\TotalRUC.TXT"
    Open strRuta For Binary As #1
    reg = Space$(100)
    Get #1, , reg ' fits exactly
    MsgBox reg
    Close #1
    For a = 1 To 100
        Cells(a, 1) = Asc(Mid(reg, a, 1))
    Next
End Sub

Te pongo los cambios para que tu búsquera funcione:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Sub LoadFile(): On Error Resume Next ' load entire file to string'
    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
    '--
    Application.ScreenUpdating = False
    'strRuta = ThisWorkbook.Path & "\TotalRUC.TXT"
    strRuta = "C:\TotalRUC.TXT"
    Open strRuta For Binary As #1
    MyData = Space$(LOF(1)) ' sets buffer to Length Of File
    Get #1, , MyData ' fits exactly
    Close #1
    MyData = chr(10) & MyData
    For x = 2 To Range("A" & Rows.Count).End(xlUp).Row - 0
        If Trim(Range("A" & x)) <> "" Then
            strBuscado = chr(10) & Range("A" & x) & "|"
            l1 = InStr(1, MyData, strBuscado)
            If l1 = 0 Then
                Range("B" & x) = "NO ES CONTRIBUYENTE"
            Else
                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" & x) = strRes(1)
                Range("C" & x) = strRes(2)
                Range("D" & x) = strRes(3)
                strnom = Split(strRes(1), ",")
                Range("E" & x) = strnom(1)
                Range("F" & x) = strnom(0)
            End If
        End If
    Next
    Cells.Replace What:="Ñ", Replacement:="Ñ"
End Sub

En el primer cambio añade un LF al principio del fichero porque es el único que no lo tiene antes del código y no lo encontraría.
El segundo cambio delimita el código por la derecha y la izquierda.

NOTA: este fichero parece venir de un sistema Unix o Linux porque en estos sistemas operativos los saltos de linea en los ficheros de texto los realiza con un LF y en MSDOS y WINDOWS con un CR+LF ( chr(13) + chr(10) ) esto provoca que intentar leerlo linea a linea sea un dolor de cabeza sobre todo la primera vez que lo intentas.


Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
Imágen de perfil de Dirk
Val: 455
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

ME AYUDAN CON ESTA MACRO PARA BUSCAR

Publicado por Dirk (166 intervenciones) el 20/01/2020 21:04:00
Hola Ruben, por lo que pude ver el RUC dentro del txt está entre "|" asi que creo que te puede funcionar buscando "|6005900" en vez de "6005900", prueba y nos avisas.... por cierto no era necesario subir los 58 MB de los RUC, con una pequeña muestra era suficiente....



Salu2
Dirk
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar