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ß
=EINDEUTIG(VSTAPELN(E3:E5;B3:B12);;1)
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
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
[
attachment=47555]
Gruß Uwe
Der Code funktioniert wie gewollt - vielen Dank. Ich werde ihn mir anschauen und versuchen zu verstehen :)
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
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
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
@ 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