ms-office.gr > Forum > Microsoft Excel > Excel samples - Χρήσιμα αρχεία & παραδείγματα > [VBA] Έλεγχος και συμπλήρωση Α.Φ.Μ.

Excel samples - Χρήσιμα αρχεία & παραδείγματα Αρχεία Ms-Excel διαθέσιμα για τα μέλη του Forum.

Απάντηση στο θέμα

 

Εργαλεία Θεμάτων Τρόποι εμφάνισης
  #1  
Παλιά 19-09-16, 12:33
Το avatar του χρήστη Spirosgr
Συντονιστής
Όνομα: Σπύρος Τσιλιγιάννης
Έκδοση λογισμικού Office: Ms-Office 2003, Ms-Office 2007, Ms-Office 2010, Ms-Office 2013, Ms-Office 2016, Ms-Office 365
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 22-11-2011
Περιοχή: Αθήνα
Μηνύματα: 2.402
Προεπιλογή Έλεγχος και συμπλήρωση Α.Φ.Μ.

Δημιουργός: 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
Καλή Επιτυχία!
Συνημμένα Αρχεία
Τύπος Αρχείου: xlsm ΑΦΜ.xlsm (21,4 KB, 170 εμφανίσεις)
Απάντηση με παράθεση
Απάντηση στο θέμα


Δικαιώματα - Επιλογές
Δε μπορείτε να δημοσιεύσετε νέα μηνύματα
Δε μπορείτε να δημοσιεύσετε απαντήσεις
Δεν μπορείτε να επισυνάψετε αρχεία
Δεν μπορείτε να επεξεργαστείτε τα μηνύματα σας

Ο κώδικας ΒΒ είναι σε λειτουργία
Τα Smilies είναι σε λειτουργία
Ο κώδικας [IMG] είναι σε λειτουργία
Ο κώδικας HTML είναι σε λειτουργία
Trackbacks are εκτός λειτουργίας
Pingbacks are εκτός λειτουργίας
Refbacks are εκτός λειτουργίας


Παρόμοια Θέματα

Θέμα Δημιουργός Forum Απαντήσεις Τελευταίο Μήνυμα
[Ερώτηση] Συμπλήρωση pdf janic00 Word - Ερωτήσεις / Απαντήσεις 0 25-04-14 11:31
[ Φόρμες ] αυτόματη συμπλήρωση eparast Access - Ερωτήσεις / Απαντήσεις 0 03-04-14 23:19
[Συναρτήσεις] Αυτόματη συμπλήρωση κελιών rmaria Excel - Ερωτήσεις / Απαντήσεις 2 25-11-12 21:59
[ Ερωτήματα ] Αυτόματη συμπλήρωση εγγραφών mdragon Access - Ερωτήσεις / Απαντήσεις 7 29-10-11 18:08
[Excel07] Αυτόματη Συμπλήρωση ΑΦΜ ippotis Excel - Ερωτήσεις / Απαντήσεις 2 10-02-11 20:14


Η ώρα είναι 08:34.