[SOLUCIONADO] Comprobar si en un rango de celdas hay coincidencia

[El_LoBooo]

Hola,

El título no es todo lo completo que debería, intentaré ser lo más claro posible.

Me gustaría poder detectar en un rango de celdas (sería una columna con aproximadamente 9000 celdas), coincidencias exactas. Me explico, supongamos que en la celda A3554 el contenido sea "pajarita para boda" y en la A8773 exactamente igual. El objetivo final sería que comprobara que hay coincidencia y una vez detectada añadir un 2 al final, si de nuevo hubiera coincidencia un 3 y así sucesivamente.

Para que quede más claro, si ése producto tuviera 3 coincidencias el objetivo sería que me devolviera:

pajarita para boda
pajarita para boda2
pajarita para boda3

Supongo que ésto no se puede hacer mediante fórmula, sino más bien con macros. En cualquier caso si alguien puede arrojarme un poco de luz y guiarme para conseguirlo estaré muy agradecido.

Saludos.

[KATHYU]

porq no usas buscar en ese tu rango y tu modificas a pajaritas 2 y 3 ???? me parece si es que no tenes demaciadas coincidencias !!!

[El_LoBooo]

Uf, eso sería una carga de trabajo importante. Son cerca de 9000 celdas, de ellas unas 500 puede que tengan coincidencia, pero buscar una por una si coincide con otra es demasiado tedioso y me quitaría mucho tiempo que necesito.

Además ésto tendría que hacerlo cada no demasiado tiempo para distintos archivos. Gracias por la ayuda pero necesito algo que me lo automatice lo máximo posible.

¿Alguna otra idea?

[mrocf]

Hola! El_LoBooo (y KATHYU).

a) Haz click derecho en la solapa de la hoja que contiene la información y selecciona: Ver código

b) En la ventana que se te abrirá copia y pega lo siguiente:

Código PHP:

  Sub Diferenciar() 
Rem ------------------ 
Rem By Cacho Rodríguez 
Rem ------------------ 
 
Dim Vec1, myDic 
Dim Q&, i&, j&, iniTime! 
 
iniTime = Timer 
Vec1 = Range([a1], Cells(Rows.Count, "a").End(xlUp)) 
Q = UBound(Vec1) 
Set myDic = CreateObject("Scripting.Dictionary") 
 
i = 1 
While i <= Q 
  If myDic.Exists(Vec1(i, 1)) Then 
    j = 1 + myDic(Vec1(i, 1)) 
    myDic.Remove (Vec1(i, 1)) 
    myDic.Add Vec1(i, 1), j 
    Vec1(i, 1) = Vec1(i, 1) & j 
  Else 
      myDic.Add Vec1(i, 1), 1 
  End If 
  i = 1 + i 
Wend 
 
[f1].Resize(Q) = Vec1 
MsgBox "Proceso terminado en: " & Format(Timer - iniTime, "0.000 seg.") 
Vec1 = Empty 
myDic = Empty 
End Sub  
   

c) Cierra todas las ventanas del ambiente Visual Basic for Application (VBA) en el que te encuentras y retorna al Excel.

d) Ejecuta la macro que recién acabas de incorporar: Diferenciar

e) En la suposición que tus datos se encuentrasen ubicados desde la celda A1 y hacia abajo, deberías obtener la solución en cuestión de décimas de segundos.

¿Te puede servir la idea?...
Saludos, Cacho R.

[El_LoBooo]

Hola mrocf!

¿Que si me puede servir la idea? ¡Es exactamente lo que buscaba!

Un millón de gracias, me has hecho ahorrar mucho tiempo.

Saludos

[KATHYU]

Buen macro !!!

[mrocf]

Iniciado por El_LoBooo

Hola mrocf!
¿Que si me puede servir la idea? ¡Es exactamente lo que buscaba!
Un millón de gracias, me has hecho ahorrar mucho tiempo. Saludos

Me alegra que así sea, y gracias por avisar.
__________________________________________

Iniciado por KATHYU

Buen macro !!!

¡Pero... Que comentario generoso! ¡Gracias!

[KATHYU]

Honor a quien honor merece mrocf !!!!!

[flordegardenia70]

Iniciado por mrocf

Hola! El_LoBooo (y KATHYU).

a) Haz click derecho en la solapa de la hoja que contiene la información y selecciona: Ver código

b) En la ventana que se te abrirá copia y pega lo siguiente:

Código PHP:

  Sub Diferenciar() 
Rem ------------------ 
Rem By Cacho Rodríguez 
Rem ------------------ 
 
Dim Vec1, myDic 
Dim Q&, i&, j&, iniTime! 
 
iniTime = Timer 
Vec1 = Range([a1], Cells(Rows.Count, "a").End(xlUp)) 
Q = UBound(Vec1) 
Set myDic = CreateObject("Scripting.Dictionary") 
 
i = 1 
While i <= Q 
  If myDic.Exists(Vec1(i, 1)) Then 
    j = 1 + myDic(Vec1(i, 1)) 
    myDic.Remove (Vec1(i, 1)) 
    myDic.Add Vec1(i, 1), j 
    Vec1(i, 1) = Vec1(i, 1) & j 
  Else 
      myDic.Add Vec1(i, 1), 1 
  End If 
  i = 1 + i 
Wend 
 
[f1].Resize(Q) = Vec1 
MsgBox "Proceso terminado en: " & Format(Timer - iniTime, "0.000 seg.") 
Vec1 = Empty 
myDic = Empty 
End Sub  
   

c) Cierra todas las ventanas del ambiente Visual Basic for Application (VBA) en el que te encuentras y retorna al Excel.

d) Ejecuta la macro que recién acabas de incorporar: Diferenciar

e) En la suposición que tus datos se encuentrasen ubicados desde la celda A1 y hacia abajo, deberías obtener la solución en cuestión de décimas de segundos.

¿Te puede servir la idea?...
Saludos, Cacho R.

hola mrocf!! tengo un poblema con una macro y no se como poder hacer la pregunta... y que me pudieras ayudar... sigo tus respuestas en otras preguntas que te hace y son geniales... espero tu respuesta. Gracias