ms-office.gr > Forum > Microsoft Excel > Excel - Ερωτήσεις / Απαντήσεις > [VBA] Μεγάλη καθυστέρηση εκτέλεσης macro

Excel - Ερωτήσεις / Απαντήσεις Ότι έχει σχέση με συναρτήσεις, μορφοποίηση, εκτυπώσεις γραφήματα κτλ.

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

 

Εργαλεία Θεμάτων Τρόποι εμφάνισης
  #1  
Παλιά 11-10-14, 08:15
Όνομα: Βασίλης
Έκδοση λογισμικού Office: Ms-Office 2003, Ms-Office 2007, Ms-Office 2010
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 08-06-2012
Μηνύματα: 81
Προεπιλογή Μεγάλη καθυστέρηση εκτέλεσης macro

Καλημέρα,

Σε αρχείο με περιπου 2000 γραμμές θέλω να διαγράψω γραμμές οι οποιες σε μία στήλη δεν περιέχουν την τιμή που θέλω...

Κώδικας:
    Sheets("Sheet1 (4)").Select
      
    I = Cells(Rows.Count, "D").End(xlUp).Row
    'Range("d" & (I + 1)) = "last row"
    
        For K = I To 1 Step -1
        If Range("D" & K) <> "Bounced and cleared" Then
            Range("D" & K).EntireRow.Delete
          
        End If
    
    Next K
Χρησιμοποίησα λοιπόν τον παραπάνω κώδικα..
Παρατήρησα όμως οτι καθυστερεί αρκετά ώστε να μου δώσει το επιθυμητό αποτέλεσμα
Μήπως υπάρχει πιό σύντομος τρόπος ;
Μπορείτε να μου δώσετε κατευθύνσεις να το ψάξω ;
Απάντηση με παράθεση
  #2  
Παλιά 11-10-14, 09:43
Το 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
Προεπιλογή

Καλημέρα
Δεν βλέπω μεγάλη καθυστέρηση.
Δοκίμασε το παρακάτω:

Με τον κώδικα αυτόν:
Κώδικας:
Sub postNumb()
    Dim i As Long
    For i = 1 To 3000
        Cells(i, 4).Value = i
    Next i
End Sub
βάζουμε στα γρήγορα για δοκιμές σε 3000 γραμμές, d στήλη αριθμούς από 1 - 3000

και με αυτόν:
Κώδικας:
Sub test()
    Dim LastRow As Long, i As Long
    LastRow = Cells(Rows.Count, 4).End(xlUp).Row
    For i = LastRow To 1 Step -1
        If Cells(i, 4) < 1000 Then
            Cells(i, 4).EntireRow.Delete
        End If
    Next i
End Sub
διαγράφουμε τα < από 1000

χρόνος εκτέλεσης 0,11 sec
Απάντηση με παράθεση
  #3  
Παλιά 11-10-14, 10:14
Όνομα: Βασίλης
Έκδοση λογισμικού Office: Ms-Office 2003, Ms-Office 2007, Ms-Office 2010
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 08-06-2012
Μηνύματα: 81
Προεπιλογή

καλημέρα Σπύρο,

έκανα λάθος ειναι περιπου 12000 οι γραμμες
δοκιμαζω αυτά που μου έγραψες και ενημερωνω

Ευχαριστώ, :)
Απάντηση με παράθεση
  #4  
Παλιά 11-10-14, 10:25
Όνομα: Βασίλης
Έκδοση λογισμικού Office: Ms-Office 2003, Ms-Office 2007, Ms-Office 2010
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 08-06-2012
Μηνύματα: 81
Προεπιλογή

παλι έχω καθυστέρηση πάνω από πέντε λεπτά σίγουρα ... :(


το laptop ειναι Hp 6475b,είναι ΟΚ σχετικά.
Απάντηση με παράθεση
  #5  
Παλιά 11-10-14, 12:21
Το 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
Προεπιλογή

Δοκίμασα με 12000 γραμμές
Ίδιος κώδικας
Ζητούμενο: διέγραψε τιμές < 5000
Χρόνος 0,34 sec
Απάντηση με παράθεση
  #6  
Παλιά 11-10-14, 13:15
Όνομα: Βασίλης
Έκδοση λογισμικού Office: Ms-Office 2003, Ms-Office 2007, Ms-Office 2010
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 08-06-2012
Μηνύματα: 81
Προεπιλογή

Χμ. Κάτι δεν γίνεται σωστά στο δικό μου....
αυτό τον κώδικα χρησιμοποιώ
και χρησιμοποιώ αλλο αρχείο με μόνο μία στήλη .....

Κώδικας:
Sub DeleteRows()
'
' deleterowsuptodown Macro
'
Dim LastRowPort As Long, a As Long
    LastRowPort = Cells(Rows.Count, 1).End(xlUp).Row
    For a = LastRowPort To 1 Step -1
        If a > 1 And Cells(a, 1) <> "" Then
            Cells(a, 1).EntireRow.Delete
        End If
    Next a

Selection.AutoFilter


End Sub

Τελευταία επεξεργασία από το χρήστη Βασίλης Καραχάλιος : 11-10-14 στις 14:13.
Απάντηση με παράθεση
  #7  
Παλιά 11-10-14, 23:30
Το 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
Προεπιλογή

Αυτό είναι «λίγο» διαφορετικό από αυτό που ζήτησες στην αρχή
Λοιπόν...

Κώδικας:
Sub DeleteRows()
    On Error Resume Next
    Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeConstants, xlNumbers).EntireRow.Delete
End Sub
Αυτό διαγράφει στην Α στήλη από κελί 2 μέχρι πάτο σταθερές που είναι αριθμοί
Αν θέλεις άλλο είδος άλλαξε αυτό
xlCellTypeConstants

και αυτό
xlNumbers

Τελευταία επεξεργασία από το χρήστη Spirosgr : 12-10-14 στις 13:21.
Απάντηση με παράθεση
Απάντηση στο θέμα

Εργαλεία Θεμάτων
Τρόποι εμφάνισης

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

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


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

Θέμα Δημιουργός Forum Απαντήσεις Τελευταίο Μήνυμα
[VBA] Epeksergasia macro-entolis ilcamorista Excel - Ερωτήσεις / Απαντήσεις 2 15-12-16 09:47
Πρόβλημα με μεγάλη μακροεντολή bdim20 Access - Ερωτήσεις / Απαντήσεις 5 08-10-14 11:32
Macro - πληροφορία γιώργοςΚ Access - Ερωτήσεις / Απαντήσεις 3 06-06-14 21:37
Εντολή μή εκτέλεσης κώδικα vba γιώργοςΚ Access - Ερωτήσεις / Απαντήσεις 12 14-01-14 12:15
[VBA] Καθυστέρηση της φόρμας anestaki Excel - Ερωτήσεις / Απαντήσεις 2 02-02-13 18:25


Η ώρα είναι 11:26.