Wort fehlt

[Juli88]

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?

[steve1da]

Hola,

das Problem von Gestern hat sich also erledigt?

Frag jedes Wort mit einer eigenen Zählenwenn-Formel ab.

Gruß,
steve1da

[Fennek]

Hallo,

eine mögliche Formel zum Prüfen, ob alle 4 Begriife in einer Zeile vorkommen, ist

Code:

=SUMMENPRODUKT(--(B1:AX1={"früh";"spät";"mittlel";"nacht"}))

Dies sollte "4" ergeben.

mfg

[steve1da]

Hola,

@Fennek: wenn ein Wort fehlt, dafür ein anderes doppelt in der Zeile steht, kommt auch 4 raus

Gruß,
steve1da

[Fennek]

@Steve:

okay, dann ging es (wiedereinmal) daneben.

[Gast 123]

Hallo 

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