Excel 2013 Διαγραφή δεδομένων

[gfevran]

Γεια σας παιδιά,
Έχω φτιάξει ένα αρχείο για να κρατάω τα έξοδα μου
μιας και βρήκα δουλειά μετά από καιρό θα ήθελα το εξής όταν από λάθος έχουν καταχωρηθεί χαρακτήρες ή σύμβολο αντί για αριθμούς και αυτό μπορεί να συμβεί σε κάποια φύλλα αν είναι δυνατό με κάποιο κουμπί να σβήνουν από όλα τα φύλλα εκτός από τα αριθμητικά πεδία
Ξέρω ότι γίνεται με έλεγχο επικύρωσης δεδομένων, θέλω αν μπορεί κάποιος να με βοηθήσει να το κάνω με vba στο .excel
Ευχαριστώ για όποια βοήθεια.

[ZORO]

Όταν σε κάποιο κελί περιέχει αριθμούς και γράμματα/σύμβολα θέλεις να διαγράφεται ολόκληρο το κελί ή μόνο το σύμβολο/χαρακτήρας αλλά να παραμένουν οι αριθμοί;

Π.χ. αν σε ένα κελί είναι καταχωρημένο 16,1κ@ θέλεις να σβήνεται ολόκληρο το κελί ή να αλλάζει σε 16,1;


Αν θέλεις να διαγράφεται εντελώς το κελί βάλε ενά κουμπί και στο συμβάν κλικ του κουμπιού βάλε τον παρακάτω κώδικα:

Dim i As Integer
Dim y As Integer
Dim ws As Worksheet
For Each ws In Worksheets
For y = 3 To 20
For i = 1 To 9
If IsNumeric(ws.Cells(y, i)) = False Then
ws.Cells(y, i) = ""
End If
Next i
Next y
Next ws

Ενώ αν θέλεις στα κελιά που περιέχουν αριθμούς και σύμβολα να διαγράφονται τα σύμβολα αλλά να διατηρούνται οι αριθμοί γράψε αυτό τον κώδικα

Dim i As Integer
Dim y As Integer
Dim ws As Worksheet
Dim st As String
Dim x As Integer
For Each ws In Worksheets
For y = 3 To 20
For i = 1 To 9
If IsNumeric(ws.Cells(y, i)) = False Then
For x = 1 To Len(ws.Cells(y, i))
If IsNumeric(Mid(ws.Cells(y, i), x, 1)) = True Or Mid(ws.Cells(y, i), x, 1) = "," Then
st = st + Mid(ws.Cells(y, i), x, 1)
End If
Next x
ws.Cells(y, i) = st
st = ""
End If
Next i
Next y
Next ws

Αν και τον δοκίμασα των κώδικα και λειτουργεί όπως πρέπει θα σε συμβούλευα πριν τον τρέξεις να κάνεις ένα αντίγραφο του αρχείου σου.

[gfevran]

Σ’ Ευχαριστώ πολύ για το χρόνο που αφιέρωσες ZORO,
εφάρμοσα τον δεύτερο κώδικα που σβήνει μόνο χαρακτήρες και σύμβολα και διατηρεί τους αριθμούς Δούλεψε τέλεια.
Θα ήθελα λίγη ακόμη βοήθεια!.
Εφάρμοσα τον δεύτερο κώδικα και σε ένα άλλο αρχείο όμως επειδή αυτό έχει Worksheets πέρα των 12 μηνών μου βγάζει σφάλμα ο κώδικας έχω κάποια κελιά κλειδωμένα παρ' όλα αυτά σβήνει τα σύμβολα και διατηρεί τους αριθμούς όπως θέλω στα Worksheets των 12 μηνών, υπάρχει τρόπος για να μην βγάζει σφάλμα να επεμβαίνει στα 12 πρώτα Worksheets μόνο που είναι οι μήνες Ιαν…Δεκεμβ.
Ευχαριστώ εκ των προτέρων.

[ZORO]

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

Τώρα αν θέλεις ο κώδικας να εκτελείτε μόνο στα πρώτα 12 worksheets θέλει απλά μια πολύ μικρή προσθήκη.

Dim i As Integer
Dim y As Integer
Dim ws As Worksheet
Dim st As String
Dim x As Integer
For Each ws In Worksheets
 If ws.Index <= 12 Then
  For y = 3 To 20
   For i = 1 To 9
    If IsNumeric(ws.Cells(y, i)) = False Then
    For x = 1 To Len(ws.Cells(y, i))
     If IsNumeric(Mid(ws.Cells(y, i), x, 1)) = True Or Mid(ws.Cells(y, i), x, 1) = "," Then
      st = st + Mid(ws.Cells(y, i), x, 1)
     End If
    Next x
 ws.Cells(y, i) = st
 st = ""
   End If
   Next i
  Next y
 End If
Next ws

[gfevran]

Σ' Ευχαριστώ πολύ ZORO,
με την προσθήκη που μου πρότεινες στον κώδικα,
If ws.Index <= 12 Then
End If
δούλεψε Τέλεια.