Excel VBA Macro για εμφάνιση, απόκρυψη σειρών.

[adtakhs]

Καλησπέρα σας.

Εδώ και πάρα πολύ καιρό είχα φτιάξει μια μακροεντολή  με την οποία  κλωνοποιούσα ένα φύλλο "Template" σε έναν ή περισσότερους κλώνους,

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

 

Ταυτόχρονα σε κάθε φύλλο εργασίας είχα μια ρουτίνα η οποία απέκρυπτε τις σειρές των κελιών μιας στήλης που είχαν μηδενικές τιμές και μια που εμφάνιζε ξανά

όλες τις γραμμές.

Το πρόβλημά μου είναι πως η διαδικασία απόκρυψης είναι πολύ αργή και όσο μεγαλώνουν τα αρχεία, τόσο περισσότερο χρόνο χάνω.

 

Η αρχική ρουτίνα ήταν η εξής :

Private Sub SpinButton1_SpinUP()

    For i = 12 To 4850
        If ActiveSheet.Range("M" & i).Value = 0 Then
         Rows(i).Select
            Selection.EntireRow.Hidden = True      
        End If    
    Next i
End Sub

Private Sub SpinButton1_SpinDOWN()
For i = 12 To 4850
         Rows(i).Select
            Selection.EntireRow.Hidden = False  
Next i
End Sub

 

Προσπάθησα να εφαρμόσω μια μακροεντολή σε πίνακα, αλλά μετά από την κλωνοποίηση ο πίνακας του νέου εγγράφου παίρνει άλλο όνομα, με αποτέλεσμα να μην δουλεύει η μακροεντολή.

Private Sub CommandButton1_Click()

' Μακροεντολή2 Μακροεντολή

    ActiveSheet.ListObjects("Πίνακας1").Range.AutoFilter Field:=13, Criteria1:= _
        ">0", Operator:=xlAnd
    

End Sub

Private Sub CommandButton2_Click()

    ActiveSheet.ListObjects("Πίνακας1").Range.AutoFilter Field:=13
End Sub

 

Έχει κανείς καμιά ιδέα για το πως μπορεί να γίνει η ίδια διαδικασία ταχύτερα ?

 

Ευχαριστώ.

 

 

 

[MastroGiannis]

 

Καλησπέρα!

Κάνε μια δοκιμή με την παρακάτω ρουτίνα:

Sub EMptyRowsVisibility(Optional ByVal fHidden As Boolean)
    Dim rngEmptyRows As Range
    
    On Error Resume Next
    Set rngEmptyRows = Range("M5:M" & Range("M" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeBlanks)
    
    If rngEmptyRows Is Nothing Then
        'No empty cells in M column. Nothing to do.
    Else
        rngEmptyRows.Cells.EntireRow.Hidden = fHidden
    End If
    Set rngEmptyRows = Nothing
    On Error GoTo 0
End Sub

Την καλείς ως εξής:

Private Sub SpinButton1_SpinUP()
    EMptyRowsVisibility True
End Sub

Private Sub SpinButton1_SpinDOWN()
    EMptyRowsVisibility
End Sub