Tengo una serie de 2 celdas en las que los valores están separados por un delimitador de coma.

Ejemplo

Celda D1 = 1,2,3,4,5,6,7,8,9,10

Celda O1 = 1,2,3,4,5,6

Primero quiero usar la función de división para pasar los valores a una matriz y luego comparar esas 2 matrices para descubrir los valores únicos / no dobles. Estos valores entonces quiero escribir en otra celda como valores con un delimitador de coma. Basado en esta respuesta

Comparación de dos dimensiones de matriz y algo que encontré sobre agregar valores a una matriz probé suerte con este código

Sub compare() 
Dim cont As Long 
Dim x As Long 
Dim y As Long 
Dim Source As Variant 
Dim Comparison As Variant 
Dim Target As Variant

With ThisWorkbook.Worksheets("Open items")
For cont = 1 To .Cells(Rows.Count, 4).End(xlUp).Row
Source = Split(.Range("D" & cont).Value, ",")
Comparison = Split(.Range("O" & cont).Value, ",")
For x = LBound(Source) To UBound(Source)
For y = LBound(Comparison) To UBound(Comparison)
If Source(x, y) = !Comparison(x, y) Then
Target(UBound(Target)) = Source(x, y).Value
Next
Next

Next cont
End Sub

Pero parece estar atascado. ¿Es esta la forma correcta de agregar un valor al Array Target? ¿Cómo llevo la matriz a la celda?

El resultado en mi ejemplo debe ser que Target contenga "7", "8", "9" y "10" y debe mostrarse en una celda en el camino

7,8,9,10

Gracias por su ayuda!

1
JohnDoe 19 jun. 2017 a las 16:43

3 respuestas

La mejor respuesta

Algunos asuntos:

  • Rows.Count se verá en la hoja activa, no necesariamente en la hoja "Abrir elementos". Por lo tanto, debe agregar el punto: .Rows.Count
  • Source(x, y) no funcionará, ya que Source solo tiene una dimensión. De hecho, y no tiene nada que ver con Source. Un comentario similar es válido para Comparison.
  • = ! no es un operador de comparación válido. Quizás quisiste <>.
  • Target no está definido y Target(UBound(Target)) siempre se referirá a la misma ubicación. En su lugar, puede agregar el resultado a una variable de cadena inmediatamente.

Además, usaría un objeto Collection para una búsqueda rápida, de modo que el algoritmo no sea O (n²) , sino O (n) :

Sub Compare()
    Dim cont As Long
    Dim source As Variant
    Dim comparison As Variant
    Dim part As Variant
    Dim parts As Collection
    Dim result As String

    With ThisWorkbook.Worksheets("Open items")
        For cont = 1 To .Cells(.Rows.Count, 4).End(xlUp).Row
            source = Split(.Range("D" & cont).Value, ",")
            comparison = Split(.Range("O" & cont).Value, ",")
            ' Add the source items in a collection for faster look-up
            Set parts = New Collection
            For Each part In source
                parts.Add Trim(part), Trim(part)
            Next
            ' Remove the comparison items from the collection
            For Each part In comparison
                On Error Resume Next ' Ignore error when part is not in parts
                    parts.Remove Trim(part)
                    If Err Then parts.Add Trim(part), Trim(part) ' Add part if not yet in parts
                On Error GoTo 0 ' Stop ignoring errors
            Next
            ' Turn the remaining collection to comma-separated string
            result = ""
            For Each part In parts
                result = result & ", " & part
            Next
            result = Mid(result, 3) ' Remove first comma and space
            ' Store the result somewhere, for example in the E column
            .Range("E" & cont).Value = result
        Next cont
    End With
End Sub

Alternativa para listas ordenadas

Cuando las listas de origen y de comparación se ordenan en orden numérico, y necesita el objetivo para mantener ese orden de clasificación, puede usar una iteración en tándem, como esta:

Sub Compare()
    Dim cont As Long
    Dim source As Variant
    Dim comparison As Variant
    Dim x As Long
    Dim y As Long
    Dim result As String

    With ThisWorkbook.Worksheets("Open items")
        For cont = 1 To .Cells(.Rows.Count, 4).End(xlUp).Row
            source = Split(.Range("D" & cont).Value, ",")
            comparison = Split(.Range("O" & cont).Value, ",")
            x = LBound(source)
            y = LBound(comparison)
            result = ""
            Do While x <= UBound(source) And y <= UBound(comparison)
                If Val(source(x)) < Val(comparison(y)) Then
                    result = result & ", " & Trim(source(x))
                    x = x + 1
                ElseIf Val(source(x)) > Val(comparison(y)) Then
                    result = result & ", " & Trim(comparison(y))
                    y = y + 1
                Else
                    x = x + 1
                    y = y + 1
                End If
            Loop
            ' Flush the remainder of either source or comparison
            Do While x <= UBound(source)
                result = result & ", " & Trim(source(x))
                x = x + 1
            Loop
            Do While y <= UBound(comparison)
                result = result & ", " & Trim(comparison(y))
                y = y + 1
            Loop
            result = Mid(result, 3) ' Remove first comma and space
            ' Store the result somewhere, for example in the E column
            .Range("E" & cont).Value = result
        Next cont
    End With
End Sub
1
trincot 20 jun. 2017 a las 09:42

Un par de cosas con este código

La variable Target (): nunca le dice al código qué tan grande es esta matriz o si desea agrandarla: mi código completo a continuación crecerá para cada coincidencia que se encuentre

Fuente (x, y) .Valor: no es necesario usar Value para las matrices. tampoco necesita x e y ya que solo está leyendo en una columna, solo necesita fuente (x)

Donde escribí MISSING en el código completo: estas líneas faltaban y te habrían causado problemas.

El propósito de Encontrado es que por cada vez que se encuentre la fuente (x) en la Comparación (y), se incremente Encontrado. Si nunca se ha incrementado, podemos suponer que se capturará en el objetivo.

Otra nota es que no especifica dónde desea enviar el destino. así que actualmente la matriz de destino no va a ninguna parte

Sub compare()
Dim cont As Long
Dim x As Long
Dim y As Long
Dim Source As Variant
Dim Comparison As Variant
Dim Target() As Variant
ReDim Target(1)

With ThisWorkbook.Worksheets("Open items")
    For cont = 1 To .Cells(.Rows.Count, 4).End(xlUp).Row
        Source = Split(.Range("D" & cont).Value, ",")
        Comparison = Split(.Range("O" & cont).Value, ",")
        For x = LBound(Source) To UBound(Source)
            Found = 0
            For y = LBound(Comparison) To UBound(Comparison)
                If Source(x) = Comparison(y) Then
                    Found = Found + 1
                    'count if found
                End If 'MISSING
            Next

            'if values are found dont add to target
            If Found = 0 Then
                Target(UBound(Target)) = Source(x)
                ReDim Preserve Target(UBound(Target) + 1)
            End If
        Next
    Next cont
End With 'MISSING
End Sub
0
99moorem 19 jun. 2017 a las 14:44

Pruebe este pequeño UDF () :

Public Function unikue(BigString As String, LittleString As String) As String
    Dim B As Variant, L As Variant, Barr, Larr
    Dim Good As Boolean

    Barr = Split(BigString, ",")
    Larr = Split(LittleString, ",")

    For Each B In Barr
        Good = True
        For Each L In Larr
            If L = B Then Good = False
        Next
        If Good Then unikue = unikue & "," & B
    Next B
    If unikue <> "" Then unikue = Mid(unikue, 2)
End Function

enter image description here

1
Gary's Student 19 jun. 2017 a las 15:18