VBA Buscar Coincidencia(Like) en Matriz de Excel
Quisiera pedir de su amable colaboración, ya que es un tema que no he podido darle respuesta, permitanme explicarle.
Actualmente tengo un Excel, donde tengo una Columna A, y en dicha columna A tengo la siguiente data:
013531-100217
013531-170117
013533-250417
1353345181
135349978
NCI-170117
NCI-49978
NCI-52001
NCI-52048
NCI-52072
NCI-52126
NCI-52157
NCI-52164
Si se fijan, tengo en una celda A el dato "013531-170117", y en otra celda tengo "NCI-170117" entonces deseo encontrarla, ya que este numero es un indicador para hacer match y es una llave que utilizan para denotar que con el documento NCI afectaron al documento "013531-170117".
Igualmente podemos ver el ejemplo del caso "135349978" y el documento "NCI-49978" donde el original, fue afectado con esta NCI,
Entonces, lo que necesito es algún VBA que me permita encontrar coincidencias, como el 'Like' o alguna forma de poder identificarlos.
Les comento que son alrededor de 2000 filas de la columna A, e igualmente tengo que ir comparando cada fila con el resto de la columna para encontrar coincidencias.
¿Alguna idea?
1 Respuesta
No entendí muy bien qué dato debe iniciar la búsqueda.
Continuando con este ejemplo:
"
"013531-170117", "NCI-170117"
"
Quieres qué tome el "170117" de este dato: "013531-¿170117" y lo busque en el resto de la columna?
O quieres que tome el "170117" de este dato: "¿NCI-170117" y lo busque en el resto de la columna?
¿Si lo encuentro qué hago?
¿Si no lo encuentro qué hago?
¿Todos los número a buscar están separados por un guión?
Hola, buenas noches Dante.
Permíteme explicarte un poco más.
Lo que yo deseo, es tener en un botón, un código VBA que me permita buscar automáticamente en un rango de filas, y me permita colorear las celdas donde encuentre parecidos (Like).
Ejemplo: Tengo un Excel con 2000 celdas, y deseo que dicho código tome celda por celda y busque parecidoso como por ejemplo, que tome la celda A1 con el contenido "013531-170117", y busque en las demás celdas alguno que contenga casi lo mismo, y que cuando lo encuentre como ejemplo "NCI-170117" le de otro color para poder distinguir que encontró un posible match.
Te comento que es para un tema contable, ya que cuando hacemos documentos, siempre al final de varios días para dejar esa cuenta a cero utilizamos el concepto 'NCI' y a la par un distintivo que hace referencia al documento que queremos dejar a cero.
Otro ejemplo: Tengo en una celda A109 el valor '135349978' y en la celda 1876 tengo el documento NCI-135349978, entonces quiere decir que yo he liquidado el documento, a lo cual lo que haría manualmente es colorearlo para quitarlo del análisis por que ya esta a cero, y con esto voy dejando unicamente los documentos que aun no tienen NCI para irlos liquidando.
Espero me haya explicado, y cualquier duda, por favor avisarme.
Desde ya muchas gracias.
Sigo sin entender cómo empezar a buscar. Mejor envíame tu archivo con ejemplos reales, me explicas en una hoja qué quieres hacer o cómo lo haces manualmente. En otra hoja me pones el resultado esperado. Explica 5 ejemplos.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “Carlos Dahbura” y el título de esta pregunta.
Estimado Dante, buenos días.
Acabo de enviar el ejemplo con lo que me pediste.
Dudas, estoy a la orden.
Te anexo la macro
Sub Buscar_Coincidencias()
'Por.Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("Data_Real")
Set h2 = Sheets("temp")
Set h3 = Sheets("resultado")
h2.Cells.Clear
h3.Cells.Clear
If h1.AutoFilterMode Then h1.AutoFilterMode = False
'
u1 = h1.Range("C" & Rows.Count).End(xlUp).Row
h1.Range("A1:L" & u1).AutoFilter Field:=3, Criteria1:="=*NCI*"
u1 = h1.Range("C" & Rows.Count).End(xlUp).Row
h1.Range("A1:L" & u1).Copy h2.Range("A1")
u2 = h2.Range("C" & Rows.Count).End(xlUp).Row
If h1.AutoFilterMode Then h1.AutoFilterMode = False
h2.Columns("C").Copy h2.Columns("M")
Call Reemplazar(h2)
'
h1.Rows(1).Copy h3.Rows(1)
j = 2
For i = 2 To u2
docu = h2.Cells(i, "C")
If InStr(1, docu, "-") > 0 Then
datos = Split(docu, "-")
If Len(datos(0)) > Len(datos(1)) Then
docu = WorksheetFunction.Trim(datos(0))
Else
docu = WorksheetFunction.Trim(datos(1))
End If
End If
existe = False
cargo = Abs(h2.Cells(i, "J"))
Set r = h1.Columns("C")
Set b = r.Find(docu, LookAt:=xlPart)
If Not b Is Nothing Then
celda = b.Address
Do
'detalle
abono = Abs(h1.Cells(b.Row, "K"))
If abono = cargo Then
h1.Rows(b.Row).Copy h3.Rows(j + 1)
h2.Rows(i).Copy h3.Rows(j)
h3.Cells(j, "C") = h3.Cells(j, "M")
j = j + 2
existe = True
Exit Do
End If
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> celda
End If
If existe = False Then
h2.Cells(i, "C").Interior.ColorIndex = 6
End If
Next
Application.ScreenUpdating = True
MsgBox "Proceso de comparación terminado", vbInformation
End Sub
'
Sub Reemplazar(h2)
h2.Columns("C:C").Replace What:="NCI-", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
h2.Columns("C:C").Replace What:="NCI ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
h2.Columns("C:C").Replace What:="NCI", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
h2.Columns("C:C").Replace What:="NC", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
h2.Columns("C:C").Replace What:="N", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
