VBA Excel | Überprüfung ob Zeile befüllt wurde.

Usen

Grünschnabel
Gute Morgen,

Ich versuche mich wieder an die VBA Programmierung in Excel. Da ich positive Ergebnisse durch diese Plattform gewinnen konnte, wollte ich diesmal nicht länger zögern und es erneut hier probieren. :)

Diesmal benötige ich folgendes:
Ich arbeite mit mehreren Personen in einer Excelliste. Damit die Einträge so effektiv wie möglich vollzogen werden, war mein Vorschlag, dass ich eine Art Pop-Up Fenster einstelle. Dieses sollte sich öffnet, wenn der Anwender seine Zeile nicht vollständig befüllt und gleich in die nächste Zeile zum Befüllen übergeht.

Ich brauch diesen "Riegel" bzw. diese Überprüfung, damit die Anwender wirklich konsequent ihre Zeilen mit Infos füllen und keine halben Sachen machen. Damit der Makros weiß, wo er Ansätzen soll, war mein Gedanke, dass ich die vom Makros zu überprüfenden Zeile mit einer Nummerierung versehe. Anhand der Nummerierung weiß der Makros oder die Schleife dann welche Zeile er greifen soll zum Überprüfen.

Ziel: Sobald der Anwender die von mir gekennzeichnete Zeile nicht vollständig befüllt, soll eine Meldung aufpoppen, die ihm aufzählt, welche Spalten noch fehlen.
Man könnte das auch visuell ausgeben, und die unvollständige Zeile komplett rot umranden.

Kann mir hierbei jemand weiterhelfen? Vorschläge sind willkommen.

Viele Grüße
Usen
 
Hier mal ein Beispiel
2018-09-13_104935.jpg

Der Code dazu:
Visual Basic:
Private pEditRowNr As Long              'Aktuelle Zeilennummer desbearbeiteten Datensatzes
Private pEditMode As Boolean            'Flag, der auskunft gibt, ob die Zeile editiert wurde
Private pIncompleteRowFlag As Boolean   'Flag, dass die Zeile nicht vollständig ist
Private pFirstMissingColNr As Long      'Spaltennummer des ersten leeren Feldes

'/**
' * Worksheet Event Change
' */
Private Sub Worksheet_Change(ByVal iTarget As Range)
    'Merken, dass und wo editiert wird
    pEditMode = True
    pEditRowNr = iTarget.Row
End Sub

'/**
' * Worksheet Event SelectionChange
' */
Private Sub Worksheet_SelectionChange(ByVal iTarget As Range)
    Dim missingFields() As String           'Array mit allen Feldnamen, die nicht ausgefüllt wurden
    
    'Wir sind im EditMode und die Zeile wird gewechselt
    If pEditMode And iTarget.Row <> pEditRowNr Then
        'Reset der globalen Variablen
        pFirstMissingColNr = 0
        pIncompleteRowFlag = False
        
        'Check für jede Spalte
        If checkField(1) Then pushArray missingFields, "Id"
        If checkField(2) Then pushArray missingFields, "Name"
        If checkField(3) Then pushArray missingFields, "Strasse"
        If checkField(4) Then pushArray missingFields, "Ort"
        
        'Die Zeile ist unvollständig
        If pIncompleteRowFlag Then
            'Meldung
            If MsgBox("Unvollständig: " & Join(missingFields, ", ") & vbCrLf & "OK=Fehler beheben, Cancel=Fehler Ignorieren", vbCritical + vbOKCancel) = vbOK Then
                'Cursor auf erstes unvollständiges Feld setzen
                Me.Cells(pEditRowNr, pFirstMissingColNr).Select
            Else
                pEditMode = False
            End If
        Else
            pEditMode = False
        End If
    End If
End Sub

'/**
' * @param  Long    Spaltennummer
' * @return Boolean Flag ob dieses Feld OK ist
' */
Private Function checkField(ByVal iColNr As Long) As Boolean
    'Prüfen ob das Feld leer ist
    If IsEmpty(Me.Cells(pEditRowNr, iColNr).Value) Then
        'Hintergund auf Gelb umstellen
        Me.Cells(pEditRowNr, iColNr).Interior.Color = vbYellow
        'Flags setzen
        pIncompleteRowFlag = True
        checkField = True
        'Erstes fehlende Spalte merken
        If pFirstMissingColNr = 0 Then pFirstMissingColNr = iColNr
    Else
        'Hintergrund auf Transparent stellen
        Me.Cells(pEditRowNr, iColNr).Interior.Color = xlNone
    End If
End Function


'/**
' * Erweitert einen Array um eins und fügt einen Inhalt hinzu
' * NewIndex = pushArray(Array, Item)
' * @param  Array       Array, der erweitert werden soll
' * @param  Variant     Neuer Wert
' * @return Long        Index des neuen Wertes
' */
Private Function pushArray(ByRef ioArray As Variant, ByVal iItem As Variant) As Long
    On Error Resume Next:   pushArray = UBound(ioArray) + 1:   On Error GoTo 0
    ReDim Preserve ioArray(pushArray):     ioArray(pushArray) = iItem
End Function
 

Anhänge

  • T407194.zip
    84,6 KB · Aufrufe: 4
Hier mal ein Beispiel
Anhang anzeigen 65651

Der Code dazu:
Visual Basic:
Private pEditRowNr As Long              'Aktuelle Zeilennummer desbearbeiteten Datensatzes
Private pEditMode As Boolean            'Flag, der auskunft gibt, ob die Zeile editiert wurde
Private pIncompleteRowFlag As Boolean   'Flag, dass die Zeile nicht vollständig ist
Private pFirstMissingColNr As Long      'Spaltennummer des ersten leeren Feldes

'/**
' * Worksheet Event Change
' */
Private Sub Worksheet_Change(ByVal iTarget As Range)
    'Merken, dass und wo editiert wird
    pEditMode = True
    pEditRowNr = iTarget.Row
End Sub

'/**
' * Worksheet Event SelectionChange
' */
Private Sub Worksheet_SelectionChange(ByVal iTarget As Range)
    Dim missingFields() As String           'Array mit allen Feldnamen, die nicht ausgefüllt wurden
  
    'Wir sind im EditMode und die Zeile wird gewechselt
    If pEditMode And iTarget.Row <> pEditRowNr Then
        'Reset der globalen Variablen
        pFirstMissingColNr = 0
        pIncompleteRowFlag = False
      
        'Check für jede Spalte
        If checkField(1) Then pushArray missingFields, "Id"
        If checkField(2) Then pushArray missingFields, "Name"
        If checkField(3) Then pushArray missingFields, "Strasse"
        If checkField(4) Then pushArray missingFields, "Ort"
      
        'Die Zeile ist unvollständig
        If pIncompleteRowFlag Then
            'Meldung
            If MsgBox("Unvollständig: " & Join(missingFields, ", ") & vbCrLf & "OK=Fehler beheben, Cancel=Fehler Ignorieren", vbCritical + vbOKCancel) = vbOK Then
                'Cursor auf erstes unvollständiges Feld setzen
                Me.Cells(pEditRowNr, pFirstMissingColNr).Select
            Else
                pEditMode = False
            End If
        Else
            pEditMode = False
        End If
    End If
End Sub

'/**
' * @param  Long    Spaltennummer
' * @return Boolean Flag ob dieses Feld OK ist
' */
Private Function checkField(ByVal iColNr As Long) As Boolean
    'Prüfen ob das Feld leer ist
    If IsEmpty(Me.Cells(pEditRowNr, iColNr).Value) Then
        'Hintergund auf Gelb umstellen
        Me.Cells(pEditRowNr, iColNr).Interior.Color = vbYellow
        'Flags setzen
        pIncompleteRowFlag = True
        checkField = True
        'Erstes fehlende Spalte merken
        If pFirstMissingColNr = 0 Then pFirstMissingColNr = iColNr
    Else
        'Hintergrund auf Transparent stellen
        Me.Cells(pEditRowNr, iColNr).Interior.Color = xlNone
    End If
End Function


'/**
' * Erweitert einen Array um eins und fügt einen Inhalt hinzu
' * NewIndex = pushArray(Array, Item)
' * @param  Array       Array, der erweitert werden soll
' * @param  Variant     Neuer Wert
' * @return Long        Index des neuen Wertes
' */
Private Function pushArray(ByRef ioArray As Variant, ByVal iItem As Variant) As Long
    On Error Resume Next:   pushArray = UBound(ioArray) + 1:   On Error GoTo 0
    ReDim Preserve ioArray(pushArray):     ioArray(pushArray) = iItem
End Function

Hallo Yaslaw,
danke für deine schnelle Antwort. Die Überprüfung müsste in meiner Liste in der 5. Zeile und in der Spalte D beginnen und sich eben zeilenweise nach unten abarbeiten und dabei die gegebenen Spalten überprüfen. Wie Setze ich nun den Startpunkt für den Makro fest?
 
Im Anhang sollte sich die Datei befinden. Ich habe auch ein Screenshot für die Beschreibung noch zusätzlich angehängt. Also so in etwa sieht meine Arbeitsfläche aus. In Spalte D erfolgt meine Nummerierung und sobald ich in dieser Spalte eine Zahl einsetzte, soll mir das Programm die Spalten E, F, G, I, L und V entsprechend zeilenweise bitte überprüfen und den Anwender quasi darauf hinweisen, dass er diese noch zu befüllen hat, wenn diese noch frei sind!
Mit einfachen Worten gesagt: Keine Nummerierung, keine Überprüfung.
->(siehe orangene Markierung)

Meine Tabelle fängt mit 3 Markierungsspalten an, die für die Programmierung keine Bedeutung haben. Ich wollte dadurch nur den Startpunkt der Nummerierung einmal verdeutlichen.

Die Spalte I wird nur von Bildern befüllt, ich weiß nicht ob dein Program diese Überprüfung hinbekommt, aber wenn es gehen sollte, wäre ich dir sehr dankbar!
________________________________________________________________________________________________________________
Zu deinem Beispielprogramm: Beim Testen deiner Tabelle ist mir aufgefallen, dass die Fehlermeldung aufpoppt, wenn man eine Zelle zuvor befüllt und diese anschließend wieder entfernen will. Trotzdem wird die entsprechende Zelle gelb markiert. Ist nur ein Optimierungs-Gedanke :).

1536907715302.png
 

Anhänge

  • Beispiel.zip
    32,6 KB · Aufrufe: 3
Zuletzt bearbeitet:
Zurück