Buscar en archivo txt, multidatos de hoja excel .

Tengo 10 mil datos en columna excel A1-A10000 y necesito buscar en archivo txt ; su correspondiente numero a su izquierda y ponerlo en celdas B1-B10000. Adjunto imagen .. En este caso seria para : 488 (excel) su correspondiente numero de 9 dígitos - 923078164 .. Gracias

1 Respuesta

Respuesta
1

En el archivo txt, el espacio que existe entre el número de la izquierda y el número de la derecha, ¿es una tabulación o son espacios en blanco?

¿El archivo txt va a estar en la misma carpeta donde se encuentra el archivo de excel?

¡Gracias! Lo primero .. hay un espacio en blanco entre un numero y el otro (derecha) ahora si es necesario que sea tabulación .. se puede hacer... y lo segundo el archivo txt puede estar en la misma carpeta si es necesario .. gracias

Entonces entre los números hay un espacio.

Guarda el archivo con la macro y el archivo txt en la misma carpeta.

Cambia en la macro el nombre del archivo txt, en esta línea:

arch = "basedatospi700.txt"

---

Hice el código de esta manera para leer los 10,000 registros de manera más rápida.

Prueba el siguiente código y comentas.

Sub Buscar_Numero()
  Dim wb2 As Workbook
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim ruta As String, arch As String
  Dim a As Variant, b As Variant
  Dim dic As Object
  Dim i As Long, fila As Long
  '
  ruta = ThisWorkbook.Path & "\"
  arch = "basedatospi700.txt"
  '
  Set sh1 = ActiveSheet
  a = sh1.Range("A1:B" & sh1.Range("A" & Rows.Count).End(3).Row).Value
  Set dic = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(a)
    dic(a(i, 1)) = i
  Next
  '
  Workbooks.OpenText Filename:=ruta & arch, Origin:=xlWindows, _
    StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlNone, _
    ConsecutiveDelimiter:=True, Tab:=False, Semicolon:=False, _
    Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1)), _
    TrailingMinusNumbers:=True
  Set wb2 = ActiveWorkbook
  Set sh2 = wb2.Sheets(1)
  '
  b = sh2.Range("A1:B" & sh2.Range("A" & Rows.Count).End(3).Row).Value
  For i = 1 To UBound(b)
    If dic.exists(b(i, 1)) Then
      fila = dic(b(i, 1))
      a(fila, 2) = b(i, 2)
    End If
  Next
  wb2.Close False
  '
  Sh1. Range("A1").Resize(UBound(a, 1), 2).Value = a
End Sub

¡Gracias! Hola cree la carpeta en escritorio pegue el archivo basedatospi700.txt y la macro.. al hacerla correr no pasa nada ...quizás donde me pides " Cambia en la macro el nombre del archivo txt, en esta línea:

arch = "basedatospi700.txt"

no comprendo como hacerlo, ¿Por qué nombre la cambio? Gracias

Pon los 2 archivos en la misma carpeta.

¿Cómo se llama tu archivo de texto?

Ese nombre lo pones en esta línea:

"basedatospi700.txt"

¡Gracias! Si así, esta... al hacer correr la macro me aparece un flash del archivo txt y queda el archivo excel con los números en la columna A.. gracias

[No olvides valorar la respuesta.

.

Hola .. El resultado no aparece en la columna B, si gustas te envío los archivos para que los veas.. gracias

Hola .. la macro no funciona ... no da el resultado en la columna B.. gracias

Envíame tus 2 archivos

[email protected]

Esta es tu respuesta:

Lo primero .. hay un espacio en blanco entre un numero y el otro

El archivo que me enviaste tiene un tabulador entre un número y el otro.

Prueba con la siguiente macro. Hice el ajuste para que leyera el archivo txt separado por tabulador.

Sub Buscar_Numero()
  Dim wb2 As Workbook
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim ruta As String, arch As String
  Dim a As Variant, b As Variant
  Dim dic As Object
  Dim i As Long, fila As Long
  '
  ruta = ThisWorkbook.Path & "\"
  arch = "pi700.txt"
  '
  Set sh1 = ActiveSheet
  a = sh1.Range("A1:B" & sh1.Range("A" & Rows.Count).End(3).Row).Value
  Set dic = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(a)
    dic(a(i, 1)) = i
  Next
  '
  Workbooks.OpenText Filename:=ruta & arch, Origin:=xlWindows, _
    StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlNone, _
    ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
    Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1)), _
    TrailingMinusNumbers:=True
  Set wb2 = ActiveWorkbook
  Set sh2 = wb2.Sheets(1)
  '
  b = sh2.Range("A1:B" & sh2.Range("A" & Rows.Count).End(3).Row).Value
  For i = 1 To UBound(b)
    If dic.exists(b(i, 1)) Then
      fila = dic(b(i, 1))
      a(fila, 2) = b(i, 2)
    End If
  Next
  wb2.Close False
  '
  Sh1. Range("A1").Resize(UBound(a, 1), 2).Value = a
End Sub

Hola .. gracias la revise y cuando repito un numero ejemplo el 10 repetido 15 veces me devuelve el numero correcto pero también otro números diferentes ..

En dónde repites el número, ¿en la hoja de excel o en el archivo txt?

¿Qué debe regresar?

Si tienes alguna complejidad con tus datos, debes especificar con ejemplos para que yo pueda entender qué datos tienes y qué resultados esperas.

Todo lo debes explicar con ejemplos claros plasmados en imágenes.

En la columna A esta repetido el numero diez ..10 = 582097494 es la respuesta en columna B.. las otras respuestas son errores .. gracias

En base a tus ejemplos y a tus archivos, realicé una nueva macro. Debe ser más rápida

Sub Buscar_Numero_2()
  Dim sh1 As Worksheet
  Dim ruta As String, arch As String, s1 As Double, s2 As Double
  Dim a As Variant, LineofText As Variant
  Dim dic As Object
  Dim i As Long
  '
  ruta = ThisWorkbook.Path & "\"
  arch = "pi700.txt"
  '
  Set sh1 = ActiveSheet
  Set dic = CreateObject("Scripting.Dictionary")
  sh1.Range("B1:B" & Rows.Count).ClearContents
  a = sh1.Range("A1:B" & sh1.Range("A" & Rows.Count).End(3).Row).Value
  '
  Open ruta & arch For Input As #1
  Do While Not EOF(1)
    Line Input #1, LineofText
    s1 = Split(LineofText, vbTab)(0)
    s2 = Split(LineofText, vbTab)(1)
    dic(s1) = s2
  Loop
  Close #1
  '
  For i = 1 To UBound(a)
    If dic.exists(a(i, 1)) Then
      a(i, 2) = dic(a(i, 1))
    End If
  Next
  '
  Sh1. Range("A1").Resize(UBound(a, 1), 2).Value = a
End Sub

¡Gracias!  Esta funcionando de maravilla ...

[Encantado de ayudarte con la macro, gra cias por comentar.

Hola Dante ... La macro funciona de maravilla, incluso estoy trabajando con 900 mil datos .Cuando hago un enlace (con columna A), con otro archivo o con la hoja 2 (para cambiar los datos más rápidamente ) y hago correr la macro. Después de terminar de buscar los datos ; se borra el enlace y al ser unos 6000 datos, me toma mucho tiempo pegar todo de nuevo .Podrías revisarla para saber si tiene solución ... Gracias

Prueba esta:

Sub Buscar_Numero_2()
  Dim sh1 As Worksheet
  Dim ruta As String, arch As String, s1 As Double, s2 As Double
  Dim a As Variant, b As Variant, LineofText As Variant
  Dim dic As Object
  Dim i As Long
  '
  Application.ScreenUpdating = False
  ruta = ThisWorkbook.Path & "\"
  arch = "pi700.txt"
  '
  Set sh1 = ActiveSheet
  Set dic = CreateObject("Scripting.Dictionary")
  sh1.Range("B1:B" & Rows.Count).ClearContents
  a = sh1.Range("A1:A" & sh1.Range("A" & Rows.Count).End(3).Row).Value
  ReDim b(1 To UBound(a, 1), 1 To 1)
  '
  Open ruta & arch For Input As #1
  Do While Not EOF(1)
    Line Input #1, LineofText
    s1 = Split(LineofText, vbTab)(0)
    s2 = Split(LineofText, vbTab)(1)
    dic(s1) = s2
  Loop
  Close #1
  '
  For i = 1 To UBound(a)
    If dic.exists(a(i, 1)) Then
      b(i, 1) = dic(a(i, 1))
    End If
  Next
  '
  sh1.Range("B1").Resize(UBound(b, 1)).Value = b
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas