Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema CommandButton
BildScreenshot zu CommandButton CommandButton-Seite mit Beispielarbeitsmappe aufrufen

Abgleich in Abhängigkeit mehrerer Spalten #2 (Piet


Betrifft: Abgleich in Abhängigkeit mehrerer Spalten #2 (Piet von: Benjamin
Geschrieben am: 16.01.2019 22:31:23

Hallo zusammen,
mein Thread ist leider aus dem Server rausgefallen. Piet hatte mir eine Lösung bereitgestellt, ich habe es aber leider nicht hinbekommen. Kannst du mir vielleicht das Beispielfile hochladen?

Hallo Benjamin
ich freue mich dir eine m.E. funktionierende Lösung anbieten zu können, es fehlt noch der  _
Praxis Test!
Der Code gehört in ein normales Modul, und im Target Makro in Tebelle Planung gehört noch der  _
Call Befehl hinein.
In Tabelle "Planung" muss nur der Anfangsteil im Code geaendert werden, s.unten! (Target!)

Im Prinzip ist es dasselbe Makro wie in Planung, nur auf eine For Nex schleife umprogrammiert.  _
Bei mir habe ich einen CommandButton eingefügt, kann dieses Makro zur Kontrolle einer ganzen Spalte auch von Hand starten. Findet es keinen fehler erfolgt nur die Anzeige "Mehrfach Test aktiv", sonst geschieht nichts. Findet es Mitarbeiter die es nicht gibt wird dieser Eintrag rot markiert. Du kannst ihn auch löschen lassen. Ansonsten erfolgt die normale Prüfung wie gehabt. 

Diese Idee ist neu, bisher in der Praxis nicht getestet. Würde mich freuen wenn es so klappt!

mfg Piet

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich1 As Range, Verfuegbar As Range
Dim Spalte As Integer, lz As Long

'** neu eingefügt:  mehrfach Test bei kopieren von Mitarbeitern
If Target.Cells.Count > 1 Then Call Verfügbarkeit_mehrfach_Test
If Target.Cells.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
dieses Makro in ein normales Modul:
Option Explicit


'Mehrfach Test nach kopieren über For Next

Sub Verfügbarkeit_mehrfach_Test()
Dim Bereich1 As Range, Verfuegbar As Range
Dim Spalte As Integer, lz As Long
Dim AC As Range, Zahl As Variant

'Aussprung wenn keine Mitarbeiter Spalte vorliegt!!
If Selection.Columns.Count > 1 Then Exit Sub
Spalte = Selection.Column  'Spalte als Index laden
If Cells(3, Spalte) <> "Mitarbeiter" Then Exit Sub

'nur Bereich Zeile 4 - 135 zum Prüfen zulaessig!!
Zahl = Mid(Selection.Address, InStrRev(Selection.Address, "$") + 1, 10)
If Zahl < 4 Or Zahl > 135 Then Exit Sub

MsgBox "Mehrfach Test aktiv"   '** kann gelöscht werden

'** lz aus Spalte-1 laden, sonst fehlen Mitarbeiter!!
lz = Cells(Rows.Count, Spalte - 1).End(xlUp).Row

Set Bereich1 = Range(Cells(4, Spalte), Cells(135, Spalte))
Set Verfuegbar = Range(Cells(142, Spalte - 1), Cells(lz, Spalte))

'Prüfung aller kopiewrten Mitarbeiter über For Next Schleife
If Not Bereich1 Is Nothing Then
  For Each AC In Selection
    If AC.Value <> Empty Then
    '** neu - Vorprüfung ob Mitarbeiter überhaupt existiert!!
    If WorksheetFunction.CountIf(Verfuegbar, AC.Value) = 0 Then
      MsgBox AC.Value & " - diesen Mitarbeiter gibt es Nicht!"
      AC.Font.ColorIndex = 3  'markieren oder löschen!!
      'AC.Value = Empty       'mit Empty wird gelöscht!
    End If
    If WorksheetFunction.CountIf(Bereich1, AC.Value) > 1 Then
        MsgBox AC & " -  Doppelter Eintrag nicht zulässig"
        Application.EnableEvents = False
        AC.Value = ""
        Application.EnableEvents = True
        AC.Select
        Set Bereich1 = Nothing
        Exit Sub
    End If
    If Verfuegbar.Find(AC.Value).Offset(0, 1) = "krank" Then
      MsgBox AC & " -  Mitarbeiter ist krank gemeldet"
      Application.EnableEvents = False
      AC.Value = ""
      Application.EnableEvents = True
      AC.Select
    ElseIf Verfuegbar.Find(AC.Value).Offset(0, 1) = "Ausbildung" Then
      MsgBox AC & " -  Mitarbeiter ist auf Schulung"
      Application.EnableEvents = False
      AC.Value = ""
      Application.EnableEvents = True
      AC.Select
    ElseIf Verfuegbar.Find(AC.Value).Offset(0, 1) = "Urlaub" Then
      MsgBox AC & " -  Mitarbeiter ist auf Schulung"
      Application.EnableEvents = False
      AC.Value = ""
      Application.EnableEvents = True
      AC.Select
    ElseIf Verfuegbar.Find(AC.Value).Offset(0, 1) = "geplant" Then
      MsgBox Ac &  " -  Mitarbeiter ist bereits geplant"
      Application.EnableEvents = False
      AC.Value = ""
      Application.EnableEvents = True
      AC.Select
    Else
            'nix machen
    End If
    End If  'For Next
  Next AC
End If

Set Bereich1 = Nothing
Set Verfuegbar = Nothing
End Sub

  

Betrifft: AW: Abgleich in Abhängigkeit mehrerer Spalten #2 (Piet von: Piet
Geschrieben am: 21.01.2019 21:49:15

Hallo Benjamin

habe gerade deinen neuen Thread gesehen, freuen mich das wir wieder zusammen arbeiten.
Dann bringen wir die angefangene Arbeit auch gemeinsam zu Ende.

mfg Piet

https://www.herber.de/bbs/user/126989.xlsm


Beiträge aus dem Excel-Forum zum Thema "Abgleich in Abhängigkeit mehrerer Spalten #2 (Piet"