Forum - VBA Απόκρυψη σειρών με τιμή 0,00

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

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

- - [VBA] Απόκρυψη σειρών με τιμή 0,00 (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/831-apokrypsi-seiron-me-timi-0-00-a.html)

Απόκρυψη σειρών με τιμή 0,00

Καλησπέρα σε όλους! Έχω ένα φύλλο εργασίας με δεδομένα σε περίπου 1000 σειρές.Θέλω με κάποιο τρόπο,να αποκρύψω ολόκληρες τις σειρές που έχουν στην στήλη D την τιμή 0,00.Ευχαριστώ εκ των προτέρων.

Παράθεση:

Αρχική Δημοσίευση από οριατης (Μήνυμα 4347)

Καλησπέρα Νίκο,
Γιατί δεν εφαρμόζεις αυτόματο φίλτρο :032:
Με το φίλτρο, στη στήλη D επιλέγεις Προσαρμογή "δεν είναι ίσο" 0 (μηδέν) :victory:

Εναλλακτικά μπορείς να προσθέσεις μια βοηθητική στήλη όπου όταν η στήλη D είναι μηδέν γράφει 1 αλλιώς γράφει μηδέν. ( =IF(D1=0;"μηδέν";1) ). Στην συνέχεια με επιλεγμένη την βοηθητική στήλη κάνεις Επεξεργασία/Μετάβαση/Ειδικά σε... τσεκάρεις Τύποι και αφήνεις τσεκαρισμένο μόνο το Κείμενο κλείνεις με ΟΚ. Στη συνέχεια Μορφή/Γραμμή/Απόκρυψη. :hmm:

Τέλος υπάρχει και η VBA :ohno:

... αλλά μάλλον το αυτόματο φίλτρο είναι η λύση.

Τα λέμε
Θανάσης

Εάν υπάρχει η δυνατότητα με VBA δεκτή.Ευχαριστώ για την απάντηση Θανάση.

Καλημέρα Νίκο.
Θεωρώ ότι πριν καταφύγουμε σε VBA καλό είναι να προσπαθούμε να λύσουμε το πρόβλημα/ερώτημα χωρίς VBA, γιατί έτσι μαθαίνουμε πολλά. :hmm: :wink:

Τώρα για μια προσέγγιση λύσης με VBA (αν και δεν είμαι ειδικός και καλό θα ήταν να τον κρίνουν οι γκουρού της VBA) θα πρότεινα τον παρακάτω κώδικα Sub HideLines()
όπου Range("D1:D1000") η περιοχή που θα γίνει ο έλεγχος και what:=0 η τιμή που αναζητάμε.
Δεν θα μας χάλαγε να βάλουμε σαν MyRange ολόκληρη την στήλη D ("D:D") νομίζω ότι είναι πολύ γρήγορος.
:icon_out:
Τα λέμε
Θανάσης

Κώδικας:

Sub HideLines()

Dim c, last, MyRange As Range

Dim i As Double

Dim s As String
 

Set MyRange = Range("D1:D1000")

i = MyRange.Cells.Count

Set last = MyRange.Cells(i)

Set c = MyRange.Find(what:=0, after:=last)

If Not c Is Nothing Then s = c.Address

Do Until c Is Nothing

    c.EntireRow.Hidden = True

    Set c = MyRange.FindNext(after:=c)

    If c.Address = s Then Exit Do

Loop

MsgBox i - MyRange.Cells.SpecialCells(xlCellTypeVisible).Count & _

    " rows are hidden now."

End Sub

προς Θανάση

Φίλε Θανάση ευχαριστώ για το χρόνο που διέθεσες για μέενα.Λειτουργεί τέλεια,ευχαριστώ πολύ.

Καλησπέρα σε όλους!

Παράθεση:

Αρχική Δημοσίευση από οριατης (Μήνυμα 4367)

Φίλε Θανάση ευχαριστώ για το χρόνο που διέθεσες για μέενα.Λειτουργεί τέλεια,ευχαριστώ πολύ.

Αν δεν κόψεις 49,9 κιλά από τη σαρδέλα, θα τους σκοτώσω όλους!!! :icon_twisted:

Μια πιο γρήγορη αλλά και πιο αξιόπιστη μέθοδο είναι και η παρακάτω:

Κώδικας:

Sub HideZeroes()

    Dim lngFound As Long
 

    On Error Resume Next

    With Range("d1:d1000")

        lngFound = Application.Match(0, .Cells, 0)

        If lngFound Then

            .EntireRow.Hidden = True

            .ColumnDifferences(.Cells(lngFound)).EntireRow.Hidden = False

            Cells(1).Activate

            MsgBox .Count - .SpecialCells(xlCellTypeVisible).Count & _

                    " rows are hidden now."

        End If

    End With

End Sub

Με άλλα λόγια... Μηδένα προ του τέλους μακάριζε. :015:

Φιλικά,
Γιάννης

Φίλε Γιάννη ευχαριστώ.Πολύ καλή λύση,είναι τέλεια.