He escrito un guión que se supone que compara el contenido de la columna A entre dos hojas en un libro de trabajo para averiguar si hay coincidencias parciales. Para ser más claro: si alguno de los contenidos de cualquier celda en coulmn A en la hoja 1 coincide con alguno de los contenidos de cualquier celda en coulmn A en la hoja 2, entonces será una coincidencia y el script lo imprimirá en una ventana inmediata.

Este es mi intento hasta ahora:

Sub GetPartialMatch()
    Dim paramlist As Range

    Set paramlist = Sheets(1).Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)

    For Each cel In Sheets(2).Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
        If InStr(1, cel(1, 1), paramlist, 1) > 0 Then  'I used "paramlist" here as a placeholder as I can't use it
           Debug.Print cel(1, 1)
        End If
    Next cel
End Sub

La cuestión es que no puedo hacer uso de esta paramlist definida en mi script. Solo lo usé allí como marcador de posición.

6
SIM 16 sep. 2018 a las 22:13

5 respuestas

La mejor respuesta

Quieres un doble bucle.

Sub GetPartialMatch()
    Dim paramlist As Range
    Dim cel as Range, cel2 as Range ; declare all variables!

    Set paramlist = Sheets(1).Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)

    For Each cel In Sheets(2).Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
        For Each cel2 in paramlist 'Sheets(1).Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
            If InStr(1, cel(1, 1), cel2, 1) > 0 Then  
                Debug.Print cel(1, 1)
            End If
        Next cel2
    Next cel
End Sub

Utilice siempre Option Explicit. Siempre.

Esto puede ser más fácil usando una columna auxiliar y una fórmula, donde la fila en la columna auxiliar indica TRUE si se encuentra un MATCH. No VBA entonces. Y será inherentemente más rápido.

2
AJD 16 sep. 2018 a las 20:00

El uso de matrices y la función Application.Match() proporciona un enfoque muy rápido:

Sub GetPartialMatch()
    Dim paramlist1 As Variant, paramlist2 As Variant
    Dim cel As Range
    Dim i As Long

    paramlist1 = Sheets(1).Range("A2", Sheets(1).Cells(Rows.Count, 1).End(xlUp)).Value ' collect all sheets(1) column A values in an array
    paramlist2 = Sheets(2).Range("A2", Sheets(2).Cells(Rows.Count, 1).End(xlUp)).Value ' collect all sheets(2) column A values in an array

    For i = 1 To UBound(paramlist1) ' loop through paramlist1 array row index
        If Not IsError(Application.Match(paramlist1(i, 1), paramlist2, 1)) Then Debug.Print paramlist1(i, 1) ' if partial match between current paramlist1 value and any paramlist2 value, then print it
    Next
End Sub

Si desea una coincidencia exacta, simplemente use 0 como último parámetro en la función Match(), es decir:

If Not IsError(Application.Match(paramlist1(i, 1), paramlist2, 0)) Then Debug.Print paramlist1(i, 1) ' if exact match between current paramlist1 value and any paramlist2 value, then print it

Por cierto, si necesita una coincidencia exacta, también puede usar el método Autofilter() del objeto Range con xlFilterValues como su parámetro Operator:

Sub GetPartialMatch2()
    Dim paramlist As Variant
    Dim cel As Range

    paramlist = Application.Transpose(Sheets(1).Range("A2", Sheets(1).Cells(Rows.Count, 1).End(xlUp)).Value) ' collect all sheets(1) column A values in an array

    With Sheets(2).Range("A1", Sheets(2).Cells(Rows.Count, 1).End(xlUp)) ' reference sheets(2) column A cells from row 1 (header) down to last not empty one
        .AutoFilter field:=1, Criteria1:=paramlist, Operator:=xlFilterValues ' filter referenced range with 'paramlist'
        If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then ' if any filtered cell other then header
            For Each cel In .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible) ' loop through all sheets(2) filtered cells but the header
                Debug.Print cel.Value2
            Next
        End If
        .Parent.AutoFilterMode = False 'remove filter
    End With
End Sub
4
DisplayName 23 sep. 2018 a las 14:14

Solo una opción más. No es muy diferente de las sugerencias anteriores ... El concepto es acelerar el procesamiento minimizando las interacciones VBA - Excel cargando los valores en matrices y procesando matrices como esta:

Dim cel as String, cel2 as String
Dim arr1() as String, arr2 As String

arr1 = Sheets(1).Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
arr2 = Sheets(2).Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)

For Each cel In arr1
    For Each cel2 in arr2
        If InStr(1, cel, cel2, 1) > 0 Then  
            Debug.Print cel
        End If
    Next cel2
Next cel

Me gustaría saber si ayuda en absoluto :)

0
AcsErno 26 sep. 2018 a las 15:01

No estoy seguro si esto es más rápido (usa más o menos el mismo algoritmo, un bucle dentro de un bucle), pero diría que es un poco más claro:

Sub SearchForPartialMatches()
    Dim needle1 As Range, needle2 As Range

    Set needle1 = Excel.Worksheets(1).Range("$B$2")

    Do While needle1.Value <> ""
        Set needle2 = Excel.Worksheets(2).Range("$B$2")

        Do While needle2.Value <> ""
            If InStr(1, needle1.Value, needle2.Value) > 0 Then
                Debug.Print needle1.Value, needle2.Value
            End If
            Set needle2 = needle2.Offset(rowoffset:=1)
        Loop
        Set needle1 = needle1.Offset(rowoffset:=1)
    Loop

End Sub

La principal diferencia es que no se repite en toda la columna, sino que comienza en la parte superior y utiliza el método offset hasta que no haya más filas (con datos).

Por supuesto, deberá cambiar la celda inicial para needle1 y needle2.

Ejecuté esto con la lista de palabras grandes EFF copiada en ambas hojas, y funcionó en aproximadamente 4 minutos (que fue menos tiempo que con @AJD, pero eso podría haber sido una casualidad). YMMV.

0
Zack 20 sep. 2018 a las 19:24

¿Has intentado agregar:

Application.Screenupdating = false
Application.Calculation = xlCalculationManual

...Code...

Application.Screenupdating = true
Application.Calculation = xlCalculationAutomatic

Estos apagan la actualización de la pantalla y el cálculo automático de fórmulas dentro de su instancia de Excel que puede ayudar a acelerar mucho el código, solo debe recordar volver a encenderlos al final o podría tener un poco de dolor de cabeza. Sin embargo, debe tenerse en cuenta que si desactiva la actualización de la pantalla, no podrá ver los resultados. Deberá desplazarse hacia atrás al final

Otra cosa a considerar sería almacenar los datos en una matriz de antemano y realizar las operaciones en la matriz y simplemente pegarla nuevamente en la hoja. Acceder a la hoja excesivamente ralentiza el código drásticamente. Trabajando con la respuesta aceptada provista por @AJD, realicé algunos cambios que esperamos lo aceleren.

Sub macro()

Dim paramlist() As Variant
Dim DataTable() As Variant
Dim cell1 As Variant
Dim cell2 As Variant

paramlist() = Sheets(1).Range("A2:A" & Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row).Value
DataTable() = Sheets(2).Range("A2:A" & Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Row).Value


For Each cell1 In paramlist
    For Each cell2 In DataTable
        If InStr(1, cell2, cell1, 1) > 0 Then
            Debug.Print cell1
            exit for
        End If
    Next cell2
Next cell1

End Sub

Hubiera sugerido esto bajo la respuesta aceptada como sugerencia, pero desafortunadamente, aún no tengo suficiente representante para comentar.

Editar: cambiar el orden de los bucles for le permite insertar un exit for más eficiente y puede omitir grandes porciones de datos dentro de la matriz de búsqueda

1
Jchang43 21 sep. 2018 a las 06:14