Forum

Forum (https://www.ms-office.gr/forum/)
-   Excel - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/)
-   -   [VBA] Επικύρωση δεδομένων με vba (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/3515-epikirosi-dedomenon-me-visual-basic-applications.html)

gfevran 13-01-15 15:42
Επικύρωση δεδομένων με vba
 
Γεια σας παιδιά,
Αν π.χ. σε μια περιοχή (Α1:C10) πληκτρολογήσω οτιδήποτε άλλο,
εκτός από αριθμητικές τιμές να παίρνω μήνυμα λάθους.
Θα ήθελα να γίνεται με vba όχι με επικύρωση δεδομένων.
Ευχαριστώ πολύ για όποια βοήθεια.

Spirosgr 13-01-15 17:19
Καλησπέρα

Αντιγράψτε τον παρακάτω κώδικα, στο φύλλο, στο συμβάν Change.

Κώδικας:
Dim c As Range, i As Long
    For i = 1 To 10
        Set c = Cells(i, 1)
        If Not IsNumeric(c) Then
            MsgBox ""
            Exit Sub
        Else
            'do nothing
        End If
    Next i
Ο κώδικας, δουλεύει για την στήλη A, κελιά 1 έως 10.

Αν θέλετε να αλλάξετε περιοχή:
Αλλάξτε τους έγχρωμους χαρακτήρες, στο For (1 to 10 με ότι άλλο - για κελιά)
Αλλάξτε τους έγχρωμους χαρακτήρες, στο Set (1 με ότι άλλο - για στήλη)

Παράδειγμα:
Για να ελέγξουμε την περιοχή C10:C35
For i = 10 to 35 και
Set c = Cells(i, 3)

Στο Else, υπάρχει ένα σχόλιο.
Αν πρέπει να κάνει κάτι άλλο ο κώδικας, βάλτε το αντί του 'do nothing

kapetang 13-01-15 18:12
1 Συνημμένο(α)
Καλησπέρα

Μια άλλη πρόταση στο συνημμένο αρχείο

Φιλικά/Γιώργος

gfevran 13-01-15 18:44
Γεια σου Σπύρο και Γιώργο,
και οι δύο προτάσεις δουλεύουν τέλεια
μου έχετε προσφέρει εξαιρετική! βοήθεια και οι δύο
Σας Υπέρ Ευχαριστώ.

Φιλικά
Γιώργος

kapetang 13-01-15 18:48
Γιώργο έκανα αλλαγή του συνημμένου για να ελέγχεται και η επικόλληση

gfevran 13-01-15 21:11
Γιώργο σε Ευχαριστώ για μια φορά ακόμη.
Ν' σαι καλά και να έχεις πάντα καλή υγεία.

Με σεβασμό και εκτίμηση
Φιλικά
Γιώργος

Tasos 14-01-15 21:23
Καλησπέρα!
Μια ακόμα προσέγγιση με VBA :

Κώδικας:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A1:C10")) Is Nothing Then
        If Not IsNumeric(Evaluate("=SUM((A1:C10)*ISNUMBER(A1:C10))")) Then
            MsgBox "Δεν επιτρέπεται η καταχώρηση κειμένου..."
            Application.Undo
        End If
    End If
End Sub
Δεν χρησιμοποιείται βρόχος και η εσφαλμένη καταχώρηση αναιρείται αυτόματα.

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

Τάσος

gfevran 14-01-15 21:42
Καλησπέρα Τάσο,
Πάρα πολύ καλό!

Σ' Ευχαριστώ
Φιλικά
Γιώργος


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

Ms-Office.gr - ©2000 - 2026, Jelsoft Enterprises Ltd.


Search Engine Optimization by vBSEO 3.3.2