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
¡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
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
