[Μορφοποίηση] αλλαγη στο δευτερο δεκαδικο ψηφιο

[Quenya]

Αρχική Δημοσίευση από kapetang

Καλημέρα

Μορφέα, μετά τη διευκρίνιση του ζητούμενου, το πρόβλημα είναι απλό.

Δε χρειάζεται αντιγραφή και επικόλληση και κώδικας VBA.

Αρκεί στη στήλη A1:A1500 να βάλλουμε ένα τύπο.

Δες το συνημμένο.

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

Καλημερα Γιωργο, υπεροχα , αυτο ειναι η λυση ,
εκαστος στο ειδος σχετικα με απλο του θεματος,
και εγω ειμαι ασχετος, μαθαινω μονο αν καποιος βρισκετε διπλα μου και μου δειχνει,
απο βιβλιο να το κανω πραξη ουτε καν,
καθενας με τις αδυναμιες του, τις δεχετε κ προχωραει

που χρησιμευει τωρα αυτο που εφτιαξες
κανει ομαδοποιηση σε 150 ξεχωριστα επιτοκια προερχομενα απο 1500 και βαλε προιοντα , σε 30 βασικες μοναδες επιτοκιων ανα 0,05.
Σας ευχαριστω παρα πολυ που λυνετε τα προβληματα μου.

[Spirosgr]

Ο κώδικας στο φύλλο

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long
    Dim nRow As Long
    nRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
    If Application.CutCopyMode = xlCopy Then
        If Intersect(Target, Columns(1)) Is Nothing Then
            Exit Sub
        Else
            Application.EnableEvents = False
            For i = 1 To nRow
                Sheet1.Cells(i, 1).Value = Application.WorksheetFunction.Ceiling(Sheet1.Cells(i, 1).Value, 0.05)
            Next i
            Application.EnableEvents = True
            Application.CutCopyMode = False
        End If
    End If
End Sub

Σημειώσεις:
Αντιγράφουμε πχ μια στήλη με 50.000 κελιά
Πάμε στο A1 και κάνουμε επικόλληση
Μετατρέπονται αυτόματα οι αξίες σε πολλαπλάσιο 0,05
Χρόνος εκτέλεσης για 50.000 γραμμές 0,5 sec
Χρόνος εκτέλεσης για 1.500 γραμμές ακαριαία

[Quenya]

Αρχική Δημοσίευση από Spirosgr

Ο κώδικας στο φύλλο

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long
    Dim nRow As Long
    nRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
    If Application.CutCopyMode = xlCopy Then
        If Intersect(Target, Columns(1)) Is Nothing Then
            Exit Sub
        Else
            Application.EnableEvents = False
            For i = 1 To nRow
                Sheet1.Cells(i, 1).Value = Application.WorksheetFunction.Ceiling(Sheet1.Cells(i, 1).Value, 0.05)
            Next i
            Application.EnableEvents = True
            Application.CutCopyMode = False
        End If
    End If
End Sub

Σημειώσεις:
Αντιγράφουμε πχ μια στήλη με 50.000 κελιά
Πάμε στο A1 και κάνουμε επικόλληση
Μετατρέπονται αυτόματα οι αξίες σε πολλαπλάσιο 0,05
Χρόνος εκτέλεσης για 50.000 γραμμές 0,5 sec
Χρόνος εκτέλεσης για 1.500 γραμμές ακαριαία

Χαιρετε Σπυρο , παρακαλω να ρωτησω τον κωδικα που εχεις γραψει απο πανω τον κανω αντιγραφη απο εδω , και τον επικολλω που ? στη θεση προβολη κωδικα με δεξι κλικ στο φυλλο ?

[Spirosgr]

Ναι, στην ίδια θέση με τον προηγούμενο, τον οποίο διαγράφεις.
Επίσης, διαγράφεις και όποιο άλλο συμβάν Worksheet_Change, έχει τυχόν ξεχαστεί...