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
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
Hola .. El resultado no aparece en la columna B, si gustas te envío los archivos para que los veas.. gracias
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
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
- Compartir respuesta