[VBA] Arrays vergleichen - Unterschied ausgeben

[EasY]

Guten Abend allerseits,

ich google schon seit einer Weile, finde allerdings keine Lösung zu meinem Problem bzw. keinen Ansatz, welchen ich verstehe :) :


Ich habe ein 1-Dimensionales Array, welches die Gesamtliste aller Mitarbeiter (Namen) darstellt.
Nun will ich ein weiteres 1-Dimensionales Array mit Namen "dagegenlaufen" lassen.

In einem dritten Array sollen nun alle Namen aufgelistet werden, die nicht in beiden Listen aufgeführt sind. Dieses Array soll später dann in eine Userform überführt werden (das soll hier aber nicht thematisiert werden, das möchte ich selber erarbeiten :) )


Wäre super, wenn ihr mir da helfen könntet. Ich bin was Arrays angeht noch sehr am Anfang, habe sie aufgrund der Geschwindigkeit allerdings lieben gelernt.

Gruß

[LCohen]

=EINDEUTIG(VSTAPELN(E3:E5;B3:B12);;1)

[EasY]

Danke für die prompte Antwort, allerdings habe ich vergessen zu erwähnen, dass ich die Tabelle auf der Arbeit benötige und da leider nur Office 2016 vorhanden ist

[Egon12]

Hallo,

eine Lösung via Array:

Code:

Option Explicit

Sub AbgleichFehlende()
    Dim arrTabIn(), arrListAll(), arrTabVgl(), arrTabAus(), varListAll$, i&, j&
    With Tabelle1
        arrTabVgl = .Range("B3:B12").Value
        arrTabIn = .Range("E3:E5").Value
        For i = 1 To UBound(arrTabIn)
            ReDim Preserve arrListAll(0 To i - 1)
            arrListAll(i - 1) = arrTabIn(i, 1)
        Next i
        varListAll = Join(arrListAll, "~")
        For i = 1 To UBound(arrTabVgl)
            If InStr(1, varListAll, arrTabVgl(i, 1)) = 0 Then
                j = j + 1
                ReDim Preserve arrTabAus(1 To j)
                arrTabAus(j) = arrTabVgl(i, 1)
            End If
        Next i
        .Cells(3, 8).Resize(j) = Application.WorksheetFunction.Transpose(arrTabAus())
    End With
End Sub

  Array-Vergleich.xlsm (Größe: 15,87 KB / Downloads: 4)
Gruß Uwe

[EasY]

Der Code funktioniert wie gewollt - vielen Dank. Ich werde ihn mir anschauen und versuchen zu verstehen :)

[Egon12]

Gerne

[snb]

Code:

Sub M_snb()
  For Each it In Cells(3, 5).CurrentRegion
    Columns(2).Replace it, ""
  Next
End Sub

oder

Code:

Sub M_snb()
  sn = Cells(3, 5).CurrentRegion
  sp = Cells(3, 2).CurrentRegion
  
  With CreateObject("scripting.dictionary")
     For j = 1 To UBound(sn)
       x0 = .Item(sn(j, 1))
     Next
     For j = 1 To UBound(sp)
       If .exists(sp(j, 1)) Then
         .Remove sp(j, 1)
       Else
         x0 = .Item(sp(j, 1))
       End If
     Next
    
     MsgBox Join(.keys, vbLf)
  End With
End Sub

[Egon12]

Hallo,

ich gebe auch noch mal meinen Dreier zum angefragten Weg es via 1-dimensionale Arrays zu erledigen dazu.
Ein möglicher Weg wäre so:

Code:

Option Explicit

Sub AbgleichFehlende()
    Dim arrListAll(), arrTabVgl(), arrTabAus(), varListAll$, i&, j&
    With Tabelle1
        arrTabVgl = Application.WorksheetFunction.Transpose(.Range("B3:B" & .Cells(Rows.Count, 2).End(xlUp).Row).Value)
        arrListAll = Application.WorksheetFunction.Transpose(.Range("E3:E" & .Cells(Rows.Count, 5).End(xlUp).Row).Value)
        varListAll = Join(arrListAll, "~")
        For i = 1 To UBound(arrTabVgl)
            If InStr(1, varListAll, arrTabVgl(i)) = 0 Then
                j = j + 1
                ReDim Preserve arrTabAus(1 To j)
                arrTabAus(j) = arrTabVgl(i)
            End If
        Next i
        .Cells(3, 8).Resize(UBound(arrTabAus)) = Application.WorksheetFunction.Transpose(arrTabAus())
    End With
End Sub

Gruß Uwe

[snb]

Code:

Sub M_snb()
  sn = Cells(3, 2).CurrentRegion
  sp = Cells(3, 5).CurrentRegion
  sq = Split(Join(Application.Transpose(sn), "_") & "_" & Join(Application.Transpose(sp), "_"), "_")
 
  For Each it In sq
    If UBound(Filter(sq, it)) = 0 Then c00 = c00 & "_" & it
  Next
  sq = Split(Mid(c00, 2), "_")
 
  Cells(3, 7).Resize(UBound(sq) + 1) = Application.Transpose(sq)
End Sub

[Egon12]

@ snb

Deine letzte Version ist zwar kürzer, aber dafür ist meine letzte Version effizienter und schneller. Sauber laufen natürlich alle Vorschläge welche wir hier hinterlassen haben.

Gruß Uwe