Fehler bei Überprüfung

Forumthread: Fehler bei Überprüfung

08.02.2023 05:54:59

Marc

Guten morgen, ich bin absoluter Anfänger in VBA und komme nicht weiter. Ich probiere in meinem VBA vieles zu Kommentieren was ich mache oder besser möchte. Ich habe folgendes Problem. Ich möchte folgendes wir haben zb. vier Schichten also Schicht A, B, C, D diese trage ich mit der Combobox ein. Jeden Tag macht jede Schicht eine Eingabe. Also gibt es den Eintrag 08.02.2023 / A,B,C,D. Im Code möchte ich überprüfen ob das schon in der Tabelle steht und wenn ja soll eine Fehlermeldung aufgehen. Im Moment kann ich die Daten so oft eingeben wie ich möchte. Obwohl ich das doch überprüfe. Wenn mir eine helfen könnte wäre super bitte mit erklärung was ich falsch mache, möchte ja lernen.

Private Sub cmd_OK_Click()
    'Variablen deklarieren
    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim lastRow As Long
    Dim i As Long
    Dim found As Boolean
    'Tabellenblatt und Liste auswählen
    Set ws = ThisWorkbook.Sheets("Datenbank")
    Set tbl = ws.ListObjects("tbl_Datenbank")
    'Combobox prüfen, ob ausgefüllt
    If cbx_S.Value = "" Then
        MsgBox "Bitte füllen Sie die Combobox aus!", vbExclamation
        cbx_S.SetFocus
        Exit Sub
    End If
    'Überprüfen, ob das Datum gültig ist
    If Not IsDate(txt_Datum.Value) Then
        MsgBox "Bitte geben Sie ein gültiges Datum ein!", vbExclamation
        txt_Datum.SetFocus
        Exit Sub
    End If
    'Prüfen, ob bereits ein identischer Datensatz vorhanden ist
    found = False
    For i = 1 To tbl.ListRows.Count
        If tbl.ListRows(i).Range(1, 3).Value = cbx_S.Value And tbl.ListRows(i).Range(1, 1).Value = txt_Datum.Value Then
            found = True
            If MsgBox("Der Datensatz ist bereits vorhanden. Möchten Sie die Daten aktualisieren?", vbYesNo + vbQuestion) = vbYes Then
        tbl.Range(lastRow, 1).Value = txt_Datum.Value
        tbl.Range(lastRow, 2).Value = txt_Tag.Value
        tbl.Range(lastRow, 3).Value = cbx_S.Value
        tbl.Range(lastRow, 4).Value = txt_ST_h.Value
        tbl.Range(lastRow, 5).Value = txt_Menge.Value
        tbl.Range(lastRow, 6).Value = txt_Plan.Value
        tbl.Range(lastRow, 7).Value = txt_Forcecast.Value
        tbl.Range(lastRow, 8).Value = txt_Bänder.Value
        tbl.Range(lastRow, 9).Value = txt_Nutzgrad.Value
        tbl.Range(lastRow, 10).Value = txt_Prod_Stö.Value
        tbl.Range(lastRow, 11).Value = txt_AT_Stö.Value
        tbl.Range(lastRow, 12).Value = txt_Pause.Value
        tbl.Range(lastRow, 13).Value = txt_Probe.Value
        tbl.Range(lastRow, 14).Value = txt_AWW.Value
                '... weitere Textboxen ...
                Exit Sub
            Else
                Exit Sub
            End If
        End If
    Next i
    'Wenn kein identischer Datensatz vorhanden, dann in nächste freie Zeile einfügen
    If Not found Then
        lastRow = tbl.Range.Rows.Count + 1
        tbl.ListRows.Add
        tbl.Range(lastRow, 1).Value = txt_Datum.Value
        tbl.Range(lastRow, 2).Value = txt_Tag.Value
        tbl.Range(lastRow, 3).Value = cbx_S.Value
        tbl.Range(lastRow, 4).Value = txt_ST_h.Value
        tbl.Range(lastRow, 5).Value = txt_Menge.Value
        tbl.Range(lastRow, 6).Value = txt_Plan.Value
        tbl.Range(lastRow, 7).Value = txt_Forcecast.Value
        tbl.Range(lastRow, 8).Value = txt_Bänder.Value
        tbl.Range(lastRow, 9).Value = txt_Nutzgrad.Value
        tbl.Range(lastRow, 10).Value = txt_Prod_Stö.Value
        tbl.Range(lastRow, 11).Value = txt_AT_Stö.Value
        tbl.Range(lastRow, 12).Value = txt_Pause.Value
        tbl.Range(lastRow, 13).Value = txt_Probe.Value
        tbl.Range(lastRow, 14).Value = txt_AWW.Value
        '... weitere Textboxen ...
    End If
    'Userform schließen
    Unload Me
End Sub

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

AW: Fehler bei Überprüfung

08.02.2023 07:10:59

ralf_b

AW: Fehler bei Überprüfung

08.02.2023 07:10:59

ralf_b

hier mal ein versuch, ungetestet

das ist doppelt gemoppelt. Listrows.add liefert bereits eine Referenz auf die neue Zeile, da muß man die nicht mehr mit rows.count zählen..
lastRow = tbl.Range.Rows.Count + 1
tbl.ListRows.Add
in deiner for schleife setzt du zwar found = true aber es bewirkt nichts, die msgbox kommt trotzdem.
mit exit for raus aus der Schleife und dann ist i bereits in der richtigen Zeile
sub datensatzschreiben lagert die Eintragung aus, damit man das nicht zweimal plfegen muß.

 
  With tbl
        'Prüfen, ob bereits ein identischer Datensatz vorhanden ist
        For i = 1 To .ListRows.Count
            If .ListRows(i).Range(3).Value = cbx_S.Value And _
               .ListRows(i).Range(1).Value = txt_Datum.Value Then
                found = True
                Exit For
            End If
        Next
                   
        If found Then
            If vbNo = MsgBox("Der Datensatz ist bereits vorhanden. " & _
                             "Möchten Sie die Daten aktualisieren?", vbYesNo + vbQuestion) Then
               Unload Me
               Exit Sub
            End If
        Else
           i = .ListRows.Add.Index
        End If
         
        Call datensatzschreiben(tbl, i)
       
    End With
    Unload Me
End Sub
'----------------------------------------------------------------------
Sub datensatzschreiben(tbl As ListObject, lastrow&)
       With tbl.ListRows(lastrow)
       
        .Range(1).Value = txt_Datum.Value
        .Range(2).Value = txt_Tag.Value
        .Range(3).Value = cbx_S.Value
        .Range(4).Value = txt_ST_h.Value
        .Range(5).Value = txt_Menge.Value
        .Range(6).Value = txt_Plan.Value
        .Range(7).Value = txt_Forcecast.Value
        .Range(8).Value = txt_Bänder.Value
        .Range(9).Value = txt_Nutzgrad.Value
        .Range(10).Value = txt_Prod_Stö.Value
        .Range(11).Value = txt_AT_Stö.Value
        .Range(12).Value = txt_Pause.Value
        .Range(13).Value = txt_Probe.Value
        .Range(14).Value = txt_AWW.Value
                '... weitere Textboxen ...
     End With
End Sub

Beliebteste Forumthreads (12 Monate)

Forumthread: Fehler bei Überprüfung

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread