Hallo zusammen,

ich versuche zur Zeit einen Datenüberprüfung für eine Tabelle zu erstellen und benötige eure Hilfe!

Meine Excel hat 2 Tabellenblätter: "Check" und "Insert". In Insert sind eine beliebige Anzahl Zeilen mit Daten, wobei die Spalten K bis O entweder 1, 2 oder 3 Spezifikationen beinhalten können. Die Spezifikationen werden stets durch ein "#" getrennt. Dabei sollten alle Zellen einer Zeile die selbe Anzahl Spezifikationen wie Spalte K beinhalten (Anzahl Spezifikationen in K = Anzahl in L – O). Spalte K kann drei Werte beinhalten:

1. 1#1#1# (3 Spezifikationen in Folgespalten L – O)
2. 1#1# (2 Spezifikationen in Folgespalten L – O)
3. 1# (1 Spezifikation in Folgespalten L – O)

Wohingegen die Spezifikationen in K noch fix (immer 1#) sind, können diese in den Folgespalten variieren. Nun möchte ich über einen Commandbutton in Check überprüfen, ob die Spalten L – O die selbe Anzahl Spezifikationen enthalten, wie K. Dies wird, da die Spezifikationen wie gesagt variabel sind, anhand der Anzahl der im Zelleninhalt vorkommenden "#" bestimmt. Ist eine Zeile nicht korrekt befüllt, soll in Check in Spalte B die Zeilennummer und eine Fehlermeldung angezeigt werden.

Mein aktueller Code erkennt komischerweise keine Fehler, auch wenn in einer Zeile Spalte K beispielsweise "1#1#", Spalte M jedoch "A#A#A#" enthält.

Sub CommandButton2_Click()
Dim lr, err, rw, cl As Long 'Definiere Variable für letzte Reihe, Fehlerzähler, Zeilen- und Spaltenanzahl als Zahl
 
Application.ScreenUpdating = False 'Deaktiviere Hintergrundaktualisierung
 
Sheets("Check").Range("B1:B" & Sheets("Check").Cells(Rows.Count, 2).End(xlUp).Row).Offset(1).ClearContents 'Lösche Inhalte in Spalte B aus Check (Fehlerlog)
 
lr = Sheets("Insert").Cells(Rows.Count, 1).End(xlUp).Row 'Finde letzte befüllte Zeile in Insert

err = 0 'Setze Fehlerzähler auf 0
    
    For rw = 2 To lr 'Für alle befüllten Zeilen ab Zeile 2
   
        Select Case Sheets("Insert").Cells(rw, 11) 'Wähle Inhalt von Spalte K
            Case "1#1#1#" 'Wenn "1#1#1#"
                For cl = 12 To 14 'Fuer Spalten L bis O
                    If Not InStr(1, Sheets("Insert").Cells(rw, cl), "#") = 3 Then 'Wenn nicht mit 3 Spezifikationen befüllt
                        Sheets("Check").Cells(Rows.Count, 2).End(xlUp)(2) = "Row " & Cells(rw, 11).Row & ": Column K includes 3 specifications but other relevant cells don't." 'Befülle Fehlerlog mit Zeilenanzahl und Fehlermeldung
                        err = err + 1 'Erhöhe Fehlerzähler um 1
                        Exit For 'Beende For Schleife
                    End If 'Beende If Funktion
                Next cl 'Naechste Spalte
            Case "1#1#" 'Wenn "1#1#"
                For cl = 12 To 14 'Fuer Spalten L bis O
                    If Not InStr(1, Sheets("Insert").Cells(rw, cl), "#") = 2 Then 'Wenn nicht mit 2 Spezifikationen befüllt
                        Sheets("Check").Cells(Rows.Count, 2).End(xlUp)(2) = "Row " & Cells(rw, 11).Row & ": Column K includes 2 specifications but other relevant cells don't." 'Befülle Fehlerlog mit Zeilenanzahl und Fehlermeldung
                        err = err + 1 'Erhöhe Fehlerzähler um 1
                        Exit For 'Beende For Schleife
                    End If 'Beende If Funktion
                Next cl 'Naechste Spalte
            Case "1#" 'Wenn "1#"
                For cl = 12 To 14 'Fuer Spalten L bis O
                    If Not InStr(1, Sheets("Insert").Cells(rw, cl), "#") = 1 Then 'Wenn nicht mit 1 Spezifikation befüllt
                        Sheets("Check").Cells(Rows.Count, 2).End(xlUp)(2) = "Row " & Cells(rw, 11).Row & ": Column K includes 1 specifications but other relevant cells don't." 'Befülle Fehlerlog mit Zeilenanzahl und Fehlermeldung
                        err = err + 1 'Erhöhe Fehlerzähler um 1
                        Exit For 'Beende For Schleife
                    End If 'Beende If Funktion
                Next cl 'Naechste Spalte
        End Select 'Beende Case Select für KID_Version
    Next rw 'Überprüfe nächste Zeile
    
If err = 0 Then 'Wenn keine Fehler gefunden
    MsgBox "All rows associated with Column K are filled correctly.", vbOKOnly, "Completed" 'Mitteilung korrekt befuellt
    Sheets("Check").CommandButton2.BackColor = RGB(0, 145, 90) 'Färbe Commandbutton grün
    Else: MsgBox "A total of " & err & " row(s) associated with Column K is not filled correctly.", vbExclamation, "Completed" 'Sonst: Fehlermeldung
    Sheets("Check").CommandButton2.BackColor = RGB(255, 0, 0) 'Färbe Commandbutton rot
End If 'Beende If Funktion
 
Application.ScreenUpdating = True 'Aktiviere Hintergrundaktualisierung

End Sub

Danke für eure Mithilfe!

Beste Grüße,
Simon