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
|