Forum - VBA Έλεγχος διπλοεγγραφής βάση του ΑΜΚΑ

Forum (https://www.ms-office.gr/forum/)

- Excel - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/)

- - [VBA] Έλεγχος διπλοεγγραφής βάση του ΑΜΚΑ (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/5530-elegxos-diploeggrafis-basi-toy-amka.html)

Έλεγχος διπλοεγγραφής βάση του ΑΜΚΑ

Καλημέρα κ καλό μήνα,
Φτιάχνω μια μικρή εφαρμογή και θέλω ελέγχω διπλό εγγραφών με βάση το ΑΜΚΑ.
Σε αυτό το σημείο θα ήθελα τη βοήθεια σας,

Ευχαριστώ για όποια βοήθεια.

Καλησπέρα σε σε όλους!

Γιώργο δοκίμασε τον παρακάτω κώδικα στη φόρμα::

Κώδικας:

Private Sub TextBox3_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)

    Dim fCell As Range

    TextBox3.Value = Trim(TextBox3.Value)

    If TextBox3.Value = "" Then Exit Sub

    Set fCell = Worksheets("Data").Range("c:c").Find(What:=TextBox3.Value, LookIn:=xlValues, Lookat:=xlWhole)

    If Not fCell Is Nothing Then

        Cancel = True

        TextBox3.Value = ""

        TextBox3.SetFocus

        MsgBox "Διπλοεγγραφή!.....", vbExclamation, "Προσοχή"

    End If

End Sub

Καλή συνέχεια!

Τάσος

Τάσο καλησπέρα,
Ευχαριστώ για την άμεση απάντηση,
προσάρμοσα την πρόταση σου και έχω το εξής πρόβλημα,
όταν ανεβάσω από τη Listbox μια εγγραφή που ήδη έχει ΑΜΚΑ
και κάνω αποθήκευση τότε αποθηκεύεται.
όταν προσθέσω νέα εγγραφή με υπάρχον ΑΜΚΑ τότε λειτουργεί καλά, βγάζει μήνυμα,
και δεν κάνει καταχώρηση.

Ευχαριστώ και πάλι
Με εκτίμηση Γιώργος

Γιώργο μου το συμβάν "TextBox3_BeforeUpdate" θα τρέξει μόνο αν προκληθεί από τον χρήστη.

Δεν τρέχει όταν αλλάξει η τιμή του πεδίου προγραμματιστικά.

Προτείνω να χρησιμοποιήσεις την παρακάτω συνάρτηση:

Κώδικας:

Private Function ValueExists(strValue As String) As Boolean

    If strValue = "" Then Exit Function

    Set fCell = Worksheets("Data").Range("c:c").Find(What:=TextBox3.Value, LookIn:=xlValues, Lookat:=xlWhole)

    ValueExists = Not fCell Is Nothing

End Function

Η συνάρτηση ελέγχει αν υπάρχει διπλότυπο στη στήλη C και μπορεί να κληθεί από οποιοδήποτε σημείο της φόρμας ως εξής:

Κώδικας:

Private Sub TextBox3_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)

    If ValueExists(Trim(TextBox3.Value)) Then

        Cancel = True

        '........

    End If

End Sub

Κώδικας:

Private Sub ListBox1_Click()

    Dim say As Long, a As Byte
 

    If ValueExists(ListBox1.Column(2)) Then

        ' Υπάρχει διπλοεγγραφή. Κάνε κάτι.

        ' πχ. Exit Sub ή Msgbox

    End If
 

    '.............

    '.............
 

End Sub

Καλή συνέχεια!

Με εκτίμηση

Τάσος

Τάσο,
Δούλεψε μια χαρά!

Ευχαριστώ πολλή.