Εμφάνιση ενός μόνο μηνύματος
  #2  
Παλιά 06-09-15, 12:37
Το avatar του χρήστη Spirosgr
Spirosgr Ο χρήστης 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.321
Προεπιλογή

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

Κώδικας:
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 γραμμές ακαριαία
Απάντηση με παράθεση