Wenn Wert nicht vorhanden dann MsgBox (speziell)

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Wenn Wert nicht vorhanden dann MsgBox (speziell)
von: Rafterman
Geschrieben am: 20.04.2015 12:00:22

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

Bild

Betrifft: AW: Wenn Wert nicht vorhanden dann MsgBox (speziell)
von: Rudi Maintaire
Geschrieben am: 20.04.2015 13:02:08
Hallo,
als Anregung:

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

Gruß
Rudi

Bild

Betrifft: AW: Wenn Wert nicht vorhanden dann MsgBox (speziell)
von: Daniel
Geschrieben am: 20.04.2015 13:16:21
Hi
probier mal das.

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
in der ersten Schleife werden alle Personalnummern in einer Schleife ohne Duplikate in einem Textstring gesammelt.
in der zweiten Schleife werden dann alle Personalnummern , bei denen die 20 vorliegt, wieder aus dem Textstring gelöscht.
Der Code geht davon aus, dass Zeile1 die Überschrift ist.
Gruß Daniel

Bild

Betrifft: AW: Wenn Wert nicht vorhanden dann MsgBox (speziell)
von: Rafterman
Geschrieben am: 20.04.2015 14:52:29
Hallo Rudi,
Hallo Daniel,
ich danke euch vielmals !
Beide Varianten funktionieren wie gewünscht.
Kompliment an euch beide und vor allem an dieses Forum
und nochmals Danke für die schnelle Antwort !
LG Rafterman

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Wenn Wert nicht vorhanden dann MsgBox (speziell)"