¿Cómo hacer una búsqueda exacta entre celdas que no coinciden con su ortografía (Excel2016)?
Antes que nada deseo que gocen de muy buena salud y también sus seres queridos y que tengan un bendecido año 2022 lleno de éxitos.
Tengo un archivo con más de 3000 nombres de empresas a los necesito agregar un nuevo valor en otra celda, el dato esta en otro archivo de Excel, he utilizado la función BUSCARV, sin embargo, el problema consiste en que el campo "Nombre de la empresa" de ambos archivos tienen diferencias en su escritura, tales como: puntos, comas, espacios, acentos, etc.
¿Cómo podría resolver dicho inconveniente para hacer una búsqueda exacta sin que tome en cuenta las diferencias antes mencionadas?
Necesito resolver este problema lo más pronto posible, agradezco toda la ayuda que me puedan brindar.
Adjunto imagen para mayor referencia de las diferencias entre los nombres.
1 respuesta
[Gra cias por los buenos deseos, de igual manera te deseo un año con mucha salud y de éxitos.
Te propongo una macro para buscar el nombre.
---
Supongo que los datos de nombre y número están en las columnas A y B.
Puedes poner el código en un tercer libro, pero los libros 1 y 2 deben estar abiertos.
---
Lo que hace la macro, en memoria, es quitar todos los caracteres y espacios y dejar solamente letras, en ambas casos.
Por ejemplo, si en el archivo 1 tienes: "Cañon, SA" y en el archivo 2 tienes "CANÓN S. A."
Lo que hace la macro es convertir ambos nombres en "canonsa", de esa manera los compara y si coinciden, entonces te pone el número.
---
Debes Ajustar los nombres de los libros y de las hojas en la macro:
Pon todo el código en un módulo y ejecuta la macro BuscarNombre.
Sub BuscarNombre()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim dic As Object
Dim a As Variant, b As Variant, c As Variant
Dim i As Long
Dim nombre As String
'
'Datos del Archivo 1
Set sh1 = Workbooks("Archivo 1").Sheets("Hoja1")
a = sh1.Range("A2:B" & sh1.Range("A" & Rows.Count).End(3).Row).Value
ReDim c(1 To UBound(a, 1), 1 To 1)
'
'Datos del Archivo 2
Set sh2 = Workbooks("Archivo 2").Sheets("Hoja1")
b = sh2.Range("A2:B" & sh2.Range("A" & Rows.Count).End(3).Row).Value
'
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(b, 1)
nombre = limpiarnombre(a(i, 1))
dic(nombre) = b(i, 2)
Next
'
For i = 1 To UBound(a, 1)
nombre = limpiarnombre(a(i, 1))
If dic.exists(nombre) Then
c(i, 1) = dic(nombre)
End If
Next
'
Sh1. Range("B2").Resize(UBound(b, 1), 1).Value = c
End Sub
Si hay algún caracter que no estoy considerando, dame un ejemplo para ponerlo en el código de la macro.
También pon el siguiente código en el mismo módulo:
Lo puse en imagen porque el editor de este foro no me permite poner la instrucción Chr
Te pongo el código, pero debes reemplazar las "xxx" por Chr
Function limpiarnombre(dato As Variant) Dim k As Long For k = 33 To 64 dato = Replace(dato, xxx(k), "") Next For k = 91 To 96 dato = Replace(dato, xxx(k), "") Next For k = 123 To 125 dato = Replace(dato, xxx(k), "") Next dato = Replace(LCase(Trim(dato)), " ", "") dato = Replace(dato, "ñ", "n") dato = Replace(dato, "á", "a") dato = Replace(dato, "é", "e") dato = Replace(dato, "í", "i") dato = Replace(dato, "ó", "o") dato = Replace(dato, "ú", "u") limpiarnombre = dato End Function
Ya encontré la manera de poner, aquí en el for, la función Chr.
Te pongo el código completo:
Sub BuscarNombre()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim dic As Object
Dim a As Variant, b As Variant, c As Variant
Dim i As Long
Dim nombre As String
'
'Datos del Archivo 1
Set sh1 = Workbooks("Archivo 1").Sheets("Hoja1")
a = sh1.Range("A2:B" & sh1.Range("A" & Rows.Count).End(3).Row).Value
ReDim c(1 To UBound(a, 1), 1 To 1)
'
'Datos del Archivo 2
Set sh2 = Workbooks("Archivo 2").Sheets("Hoja1")
b = sh2.Range("A2:B" & sh2.Range("A" & Rows.Count).End(3).Row).Value
'
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(b, 1)
nombre = limpiarnombre(a(i, 1))
dic(nombre) = b(i, 2)
Next
'
For i = 1 To UBound(a, 1)
nombre = limpiarnombre(a(i, 1))
If dic.exists(nombre) Then
c(i, 1) = dic(nombre)
End If
Next
'
sh1.Range("B2").Resize(UBound(b, 1), 1).Value = c
End Sub
Function limpiarnombre(dato As Variant)
Dim k As Long
For k = 33 To 64
dato = Replace(dato, Chr (k), "")
Next
For k = 91 To 96
dato = Replace(dato, Chr (k), "")
Next
For k = 123 To 125
dato = Replace(dato, Chr (k), "")
Next
dato = Replace(LCase(Trim(dato)), " ", "")
dato = Replace(dato, "ñ", "n")
dato = Replace(dato, "á", "a")
dato = Replace(dato, "é", "e")
dato = Replace(dato, "í", "i")
dato = Replace(dato, "ó", "o")
dato = Replace(dato, "ú", "u")
limpiarnombre = dato
End Function
¡Gracias!
Lo checo y le comento como me fue, saludos.
Buenas noches Dante Amor, los caracteres que hacen falta incluir son: el punto, la coma, el espacio y también las vocales acentuadas en mayúsculas puesto que en el primer archivo los nombres están en minúsculas y el segundo todo esta escrito en mayúsculas . Por otro lado, te comento que al ejecutar la macro me marco el siguiente error:
El punto, la coma, el espacio y también las vocales acentuadas en mayúsculas puesto que en el primer archivo los nombres están en minúsculas y el segundo todo esta escrito en mayúsculas .
Todos están incluidos!
Los caracteres punto y coma están incluidos en estas sentencias:
For k = 33 To 64 dato = Replace(dato, Chr (k), "") Next For k = 91 To 96 dato = Replace(dato, Chr (k), "") Next For k = 123 To 125 dato = Replace(dato, Chr (k), "") Next
El espacio y convertir a minúsculas está incluido en esta línea:
Dato = Replace(LCase(Trim(dato)), " ", "")
Y todas las letras acentuadas están aquí:
dato = Replace(dato, "á", "a") dato = Replace(dato, "é", "e") dato = Replace(dato, "í", "i") dato = Replace(dato, "ó", "o") dato = Replace(dato, "ú", "u")
---
Te muestro la tabla ascii de caracteres:
Todos los caracteres marcados en amarillo están considerados en la macro.
Me refiero, a que si después de ejecutar la macro, tienes algún nombre que no encontró su número. Entonces puede deberse a un caracter que no estoy considerando. Pero necesito que me digas el ejemplo.
---
En cuanto al error, es un problema en tus datos o de tu hoja o de tu segundo libro.
Si te das cuenta estas dos líneas son similares:
a = sh1.Range("A2:B" & sh1.Range("A" & Rows.Count).End(3).Row).Value
b = sh2.Range("A2:B" & sh2.Range("A" & Rows.Count).End(3).Row).ValuePero te marcó error en la línea del segundo libro.
Revisa qué diferencia tienes entre la hoja del primer libro y la hoja del segundo libro.
---
Si gustas, puedo revisar tus archivos. Envíamelos a mi correo.
Tenias mucha razón Dante, tenia un error de escritura en el nombre de la hoja.
¡Gracias!
Ojala puedas ayudarme con esta nueva pregunta ¿Cómo renombrar archivos PDF a partir de una lista Excel?
