Forum - VBA Έλεγχος και συμπλήρωση Α.Φ.Μ.

Δημιουργός: Spirosgr
Έτος: 2016
Βαθμός Δυσκολίας: 5/10

Ο κώδικας, δημιουργήθηκε «περιφραστικά», για καλύτερη κατανόηση, στο τι κάνει.
Θεωρούμε ότι δεν υπάρχουν Α.Φ.Μ. που αρχίζουν με περισσότερα από δύο μηδενικά.

Στο πρότυπο, συμπληρώνουμε την στήλη (Α) με τους αριθμούς Φ.Μ.
Η στήλη (Β) μένει κενή.

Εκτελούμε τον κώδικα Validate_VAT

Τι κάνει:
Ελέγχει, κάθε κελί της (Α), για το μήκος και την εγκυρότητα του Α.Φ.Μ. και
αποδίδει ανάλογα χρωματισμό και περιγραφή στα «ευρήματα».

Πως το κάνει:
Αποχρωματίζει κατ αρχήν την στήλη (Α)
Σε κάθε κελί της (A), ελέγχει, αν το μήκος του αριθμού, είναι 9,8,7...

Αν είναι 9:
Ελέγχει την εγκυρότητα.
Αν έγκυρος,
βάζει στο διπλανό κελί της (Β) περιγραφή «Έγκυρος» και συνεχίζει στο επόμενο κελί.
Αν μη έγκυρος,
χρωματίζει γκρι, βάζει στο διπλανό κελί της (Β) περιγραφή «Μη Έγκυρος» και
συνεχίζει στο επόμενο κελί.

Αν είναι 8:
Προσθέτει στην αρχή ένα μηδενικό και ελέγχει την εγκυρότητα.
Αν έγκυρος,
βάζει στο διπλανό κελί της (Β) περιγραφή «Έγκυρος» και συνεχίζει στο επόμενο κελί.
Αν μη έγκυρος,
χρωματίζει γκρι, βάζει στο διπλανό κελί της (Β) περιγραφή «Μη Έγκυρος» και
συνεχίζει στο επόμενο κελί.

Αν είναι 7:
Προσθέτει στην αρχή δύο μηδενικά και ελέγχει την εγκυρότητα.
Αν έγκυρος,
βάζει στο διπλανό κελί της (Β) περιγραφή «Έγκυρος» και συνεχίζει στο επόμενο κελί.
Αν μη έγκυρος,
χρωματίζει γκρι, βάζει στο διπλανό κελί της (Β) περιγραφή «Μη Έγκυρος» και
συνεχίζει στο επόμενο κελί.

Αν είναι μικρότερο του 7 (συμπεριλαμβάνεται και το κενό):
Χρωματίζει κόκκινο, βάζει στο διπλανό κελί της (Β) περιγραφή «Εσφαλμένος» και
συνεχίζει στο επόμενο κελί.

Σημειώσεις:
1
Στην αρχή και το τέλος έχει χρησιμοποιηθεί ένας μετρητής χρόνου εκτέλεσης.
Δοκιμή 7.500 γραμμών σε 2,51 -2,58 sec.
Μπορείτε να τον αφαιρέσετε αν θέλετε...
2
Όπου, Sh1 = το κωδικό όνομα φύλλου.
3
Ο κώδικας λειτουργεί στις στήλες: (Α) και (Β) του φύλλου.
Μπορείτε να αντικαταστήσετε τις στήλες αν θέλετε.
Παράδειγμα για την στήλη (D):

Κώδικας:

    lr = Sh1.Cells(Rows.Count, 4).End(xlUp).Row

    Set rng = Sh1.Range("d2:d" & lr)

Η στήλη (E) μένει κενή.

Αλλαγή σεναρίου:
Έστω ότι υπάρχουν Α.Φ.Μ. με τρία μηδενικά στην αρχή.

Αντιγράψτε το τμήμα του κώδικα, που είναι μέσα σε ''''''''''''
στον έτοιμο χώρο "ΕΔΩ__" και αλλάξτε τις δύο πρώτες γραμμές
από

Κώδικας:

        If Len(c) = 7 Then    'Αν 7 ψηφία

            c.Value = 0 & 0 & c.Value

σε

Κώδικας:

        If Len(c) = 6 Then    'Αν 6 ψηφία

            c.Value =0 & 0 & 0 & c.Value

Το δε τελευταίο τμήμα
από

Κώδικας:

If Len(c) < 7 Then

σε

Κώδικας:

If Len(c) < 6 Then

Καλή Επιτυχία!