Forum - Γενικά Δημιουργία κουμπιού και δημιουργία νέας λίστας

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

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

- - [Γενικά] Δημιουργία κουμπιού και δημιουργία νέας λίστας (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/1049-dimioyrgia-koympioi-kai-dimioyrgia-neas-listas.html)

Δημιουργία κουμπιού και δημιουργία νέας λίστας

Καλησπέρα.

Είναι η πρώτη μου δημοσίευση και θα εκτιμούσα την βοήθειά σας σε ένα θέμα που αντιμετωπίζω,

Έχω ένα αρχείο με 5 στήλες (κωδικός προϊόντος, περιγραφή, ποσότητα, τιμή μονάδας, σύνολο) και αυτό που κάνω είναι να εισάγω τις ποσότητες των προϊόντων και να υπολογίζεται ένα σύνολο. Επίσης σε ένα άλλο κελί εισάγω ένα ποσοστό έκπτωσης επί του συνόλου και υπολογίζεται το τελικό ποσό.

Το πρόβλημά μου είναι το εξής. Επειδή θέλω αυτό να το εκτυπώνω σαν προσφορά και επειδή οι γραμμές είναι πολλές (πάνω από 1000), θέλω να δημιουργήσω σε πρώτη φάση ένα κουμπί στο φύλλο εργασίας. Πατώντας αυτό το κουμπί, να βλέπει σε ποιες γραμμές η στήλη σύνολο ΔΕΝ έχει τιμή 0,00 και να μου εμφανίζει τις μη μηδενικές γραμμές σε ένα νέο φύλλο εργασίας, ώστε εγώ μετά να έχω να τυπώσω πολύ λιγότερες γραμμές.

Επισυνάπτω και ένα δείγμα του αρχείου μου. Θα εκτιμούσα κάθε πιθανή ιδέα, και πολύ περισσότερο την λύση :P

Καλημέρα Βασίλη και καλωσόρισες στο φόρουμ!

Αντιστοίχισε τον παρακάτω κώδικα σε ένα κουμπί και δοκίμασε:

Κώδικας:

Option Explicit
 

Sub CopyNonZeros()

    Dim rng As Range, Calc As Long

    With Application

        Calc = .Calculation

        .Calculation = xlCalculationManual

        .ScreenUpdating = False

        With Range("A1:E" & Range("E" & Rows.Count).End(xlUp).Row)

            .AutoFilter Field:=5, Criteria1:="<>0", Operator:=xlAnd

        End With

        Set rng = Sheet1.AutoFilter.Range

        rng.Copy

        Sheet2.UsedRange.Delete    'Sheet2 = το κωδικό όνομα του φύλλου (όπως φαίνεται στον VBE)

        With Sheet2.Range("A1")    ' όπου γίνεται η επικόλληση. Ίσως χρειαστεί προσαρμογή

            .PasteSpecial xlPasteAll

            .PasteSpecial xlPasteColumnWidths

            .PasteSpecial xlPasteValues

        End With

        ActiveSheet.AutoFilterMode = False

        .CutCopyMode = False

        .Calculation = Calc

        Sheet2.Activate

        .ScreenUpdating = True

    End With

End Sub

Προσοχή! Το όνομα Sheet2 στον κώδικα ίσως χρειαστεί να προσαρμοστεί σύμφωνα με το
όνομα του νέου φύλλου που θα δημιουργήσεις (για μια και μοναδική φορά).

Το κωδικό όνομα του νέου φύλλου φαίνεται στην εικόνα παρακάτω:

Συνημμένο Αρχείο 1330

Καλή συνέχεια!

Φιλικά

Τάσος

Για δες και μια λυση στο ιδιο φυλλο

Φιλικα Δημητρης

Καλημέρα!

Δοκίμασα και τους 2 τρόπους και δουλέψαν μια χαρούλα! Ευχαριστώ!