es muss in den spalten "A"- "AX" jeden tag "FRÜH", "MITTEL", "SPÄT" und "NACHT" vorkommen. Kann ich in der letzten Spalte anzeigen lassen mit "STOP" falls eines der Wörter fehlt?
anbei ein Makro Code, der das Problem -mit Fehlermeldung- löst. In Spalte AY erscheint die Spalte/n, wo ein Wert fehlt. Einfach in ein Modulblatt kopieren und laufen lassen. Das Makro in ein Modulblatt kopieren und selbst testen. Die Datei muss dann als .xlsm gespeichert werden.
(Falls das nicht geht kann man das Makro auch in eine externe Prüfdatei umschreiben)
mfg Gast 123
Code:
Option Explicit '10.1.2017 Gast 123 Clever Forum
'es muss in den spalten "A"- "AX" jeden tag "FRÜH", "MITTEL", "SPÄT" und "NACHT"
Sub Prüfung_mit_Fehleranzeige()
Dim AC As Object, AX As Object
Dim flg As String, j As Integer
Dim Txt As String, gTxt As String
Dim Wert, fe As Integer, lz As Long
'zu prüfender Text festlegen
Wert = Array("FRÜH", "MITTEL", "SPÄT", "NACHT")
'letzte Zelle in Spalte A ermitteln
lz = Cells(Rows.Count, "A").End(xlUp).Row
'Fehler Spalte AY löschen
Range("AY1:AY" & lz).ClearContents
'Schleife für alle Zeilen prüfen
For Each AC In Range("A2:A" & lz)
gTxt = Empty 'Fehler Text
'Schleife für alle Zeilen prüfen
For Each AX In AC.Resize(1, 50)
flg = Empty 'Flag löschen
'Schleife für Tageszeiten "Früh" etc.
For j = 0 To 3
If AX.Value = Wert(j) Then flg = "ok": Exit For
Next j
'Fehlende Spalte/n ermitteln
If flg = Empty Then
Txt = Mid(AX.Address, 2, InStr(Mid(AX.Address, 2, 3), "$") - 1)
gTxt = gTxt & ", " & Txt: fe = fe + 1
End If
Next AX
'Fehler in Spalte AY anzeigen
If gTxt <> "" Then Cells(AC.Row, "AY") = " " & Mid(gTxt, 2, 200)
Next AC
MsgBox fe & " Fehler in Liste"
End Sub
Folgende(r) 1 Nutzer sagt Danke an Gast 123 für diesen Beitrag:1 Nutzer sagt Danke an Gast 123 für diesen Beitrag 28 • Juli88