Wenn Wert nicht vorhanden dann MsgBox (speziell)

Hallo VBA-Experten,
komme in einem Teil-Bereich meines großen Makros nicht weiter
und hoffe Ihr könnt mir helfen.
Ich habe eine Tabelle mit Personalnummern in Spalte A
mit bestimmten Werten in Spalte B.
Nun möchte ich prüfen, ob ein Wert in Spalte B zu der Personalnummer vorkommt.
Im Bsp. suchen wir Wert 20 in Spalte B, wenn dieser Wert nicht vorkommt, soll eine MsgBox ausgegeben werden, jedoch nur einmal pro Personalnummer !
Bsp.:
Spalte A(Pers.Nr.);Spalte B(Wert)
1;5
1;10
1;15
1;20
1;25
2;5
2;10
3;5
3;10
3;25
4;10
4;20
5;5
5;10
5;15
5;20
6;25
Das Ergebnis müsste folgendermaßen lauten:
"Wert 20 fehlt bei Personalnummer 2, 3 und 6"
Toll wäre es, diese Info in einer MsgBox zu erhalten,
nachdem das Makro alle gefüllten Zeilen in Spalte A durchlaufen hat.
Es reicht aber auch wenn pro Personalnummer eine MsgBox ausgegeben wird,
was zum oberen Bsp. drei MsgBoxen wären.
Da ich diese Anforderung in mein Makro bauen möchte, benötige ich die Lösung per VBA.
Hoffe Ihr könnt mir weiterhelfen,
vielen Dank schon mal im Voraus.
LG Rafterman

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub aaa() Dim i As Long, objPNr As Object, objVorh As Object, strAus As String, oTest, arrIn Const wert As Integer = 20 Set objPNr = CreateObject("Scripting.Dictionary") Set objVorh = CreateObject("Scripting.Dictionary") With Cells(1, 1).CurrentRegion arrIn = .Offset(1).Resize(.Rows.Count - 1) End With For i = 1 To UBound(arrIn) objPNr(arrIn(i, 1)) = 0 If arrIn(i, 2) = wert Then objVorh(arrIn(i, 1)) = 0 End If Next For Each oTest In objPNr If Not objVorh.exists(oTest) Then strAus = strAus & "; " & oTest End If Next strAus = Mid(strAus, 3) MsgBox wert & " fehlt bei " & strAus End Sub

Sub Check20() Dim arr Dim z As Long, s As Long Dim Suchwert As Long Dim PNs As String Suchwert = 20 arr = Range("A1").CurrentRegion PNs = ";" For z = 2 To UBound(arr, 1) If InStr(PNs, ";" & arr(z, 1) & ";") = 0 Then PNs = PNs & arr(z, 1) & ";" Next For z = 2 To UBound(arr, 1) If arr(z, 2) = Suchwert Then PNs = Replace(PNs, ";" & arr(z, 1) & ";", ";") Next MsgBox "Wert fehlt bei den Personalnummern " & Mid$(PNs, 2, Len(PNs) - 2) End Sub

Beliebteste Forumthreads (12 Monate)

Wenn Wert nicht vorhanden dann MsgBox (speziell)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

373 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Wenn Wert nicht vorhanden dann MsgBox (speziell)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

373 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread