Forum - VBA Μεγάλη καθυστέρηση εκτέλεσης macro

Forum (https://www.ms-office.gr/forum/)

- Excel - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/)

- - [VBA] Μεγάλη καθυστέρηση εκτέλεσης macro (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/3353-megali-kathysterisi-ektelesis-macro.html)

Βασίλης Καραχάλιος

11-10-14 07:15

Μεγάλη καθυστέρηση εκτέλεσης 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

Χρησιμοποίησα λοιπόν τον παραπάνω κώδικα..
Παρατήρησα όμως οτι καθυστερεί αρκετά ώστε να μου δώσει το επιθυμητό αποτέλεσμα
Μήπως υπάρχει πιό σύντομος τρόπος ;
Μπορείτε να μου δώσετε κατευθύνσεις να το ψάξω ;

Spirosgr

11-10-14 08:43

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

Με τον κώδικα αυτόν:

Κώδικας:

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

Βασίλης Καραχάλιος

11-10-14 09:14

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

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

Ευχαριστώ, :)

Βασίλης Καραχάλιος

11-10-14 09:25

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

το laptop ειναι Hp 6475b,είναι ΟΚ σχετικά.

Spirosgr

11-10-14 11:21

Δοκίμασα με 12000 γραμμές
Ίδιος κώδικας
Ζητούμενο: διέγραψε τιμές < 5000
Χρόνος 0,34 sec

Βασίλης Καραχάλιος

11-10-14 12:15

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

Κώδικας:

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

Spirosgr

11-10-14 22:30

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

Κώδικας:

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

Η ώρα είναι 17:18.

Search Engine Optimization by vBSEO 3.3.2