Forum - Γενικά Φίλτρο με TRUE,FALSE

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

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

- - [Γενικά] Φίλτρο με TRUE,FALSE (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/2078-filtro-me-true-false.html)

Λυπαμαι κυριε Θαναση αλλα δεν καταφερα κατι.
Δεν ξερω τι ειναι αυτο που κανω λαθος.
Χωρις να ενοχλω η λυση με κωδικα μου φανηκε πιο ευκολη.
Εαν θελετε προσπαθηστε να κανετε κατι εκει .
Φιλικα και με Εκτιμηση Γρηγορης.

Καλημέρα σε όλους
Κοίτα το συνημμένο και πες μας
Θανάσης

Καλησπέρα!

Για όσους ενδιαφερθούν:

Αφού χρησιμοποιούμε βιβλίο εργασίας με μορφή *xlsm θα ήταν πιο πρακτικό τα δεδομένα να βρίσκονται σε λίστα.

Αυτό σε συνδυασμό με το InputBox της Excel (όχι της VBA) μπορεί να προσφέρει στον απλό χρήστη
τη δυνατότητα να διευρύνει τα δεδομένα του όσο θέλει και να τοποθετήσει τα αποτελέσματα όπου θελήσει (στο ίδιο ή σε άλλο φύλλο), χωρίς περιορισμούς.

Επισυνάπτω σχετικό παράδειγμα.

Φιλικά

Τάσος

Καταπληκτικη δουλεια Κυριε Θαναση(ThanosP) ειστε αλλωστε τοσοι πολλοι που μπερδευετε κανεις.
Σε αυτο λοιπον που ανεβασατε 2 πραγματα και ειμαστε ετοιμοι.
1.Οταν τελειωσει με το φιλτρο και βαλει ολα τα true αριστερα τα fulse να τα διαγραφει εντελως.
2.να μην εχω περιορισμο στον κωδικα που να αφορα τον αριθμο των στηλων που εχω τα δεδομενα μου.να εχω δυνατοτητα να βαλω οσες στηλες θελω.
Αυτα φιλοι μου και το τελειωσαμε.

Αγαπητέ Γρηγόρη,

αν διαβάσεις προσεκτικά το προηγούμενο** μήνυμα μου θα δεις ότι περιγράφεται ακριβώς αυτό που ζητάς.

Παράθεση:

Επεξεργασία**

Αν θέλεις απλά να αφαιρείς τις στήλες που περιέχουν 'FALSE' τότε πιστεύω ότι το παράδειγμα που επισυνάπτω θα σε βοηθήσει.

Τάσος

ΥΓ.
Θανάση,
Dim a(100), x, k, m, r, z, i As Integer

σημαίνει:

Dim a(100) As Variant, x As Variant, k As Variant, m As Variant, r As Variant, z As Variant, i As Integer

Καλησπέρα
"Dim a(100), x, k, m, r, z, i As Integer", οι τιμές που θα πάρουν οι μεταβλητές θα είναι ακέραιοι αριθμοί δεν είναι απαραίτητο να ορίζεται η κάθε μια ξεχωριστά, για τον Τάσο.
Γρηγόρη, πρέπει να είναι εντάξει !!
Θανάσης

t(i, r) = Cells(m, a(i))
Εδω μου χτηπησε run-time error 9 subscipt out of range οταν επιχειρησα να βαλω 650 στηλες με δεδομενα απο ενα αλλο φυλλο.
υπαρχει καποιος περιορισμος που πρεπει να εχω υποψην?
ΕΥΧΑΡΙΣΤΩ.

Αγαπητέ Θανάση,
1) Οι μεταβλητές στη στη VBA και στη VB6 θεωρούνται Variant αν δεν ακολουθεί το διευκρινιστικό As μετά από την κάθε μια χωριστά.

Η εικόνα από τον VBE στο αρχείο σου δείχνει καθαρά τον τύπο των μεταβλητών που δηλώνεις:

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

Εδώ υπάρχει και σχετικό άρθρο: Declaring Variables

2) Δεν υπάρχει λόγος το Range του φύλλου που είναι από μόνο του πίνακας (Array) να το ξαναπερνάς σε Array.

Ο κώδικας είναι γρηγορότερος και ευανάγνωστος όταν χρησιμοποιείς κατευθείαν το Range Object.

Έδωσα ήδη 2 παραδείγματα που ελπίζω ότι θα ωφελήσουν κάποιους που έχουν βέβαια κάποιες γνώσεις VBA και Excel.

Θα προσπαθήσω να απλοποιήσω τη διαδικασία παραθέτοντας τον παρακάτω κώδικα που βασίζεται στο ζητούμενο του θέματος (έτσι όπως εξελίχθηκε):

Κώδικας:

Sub DeletAllFalseColumns()

    Dim i As Integer, rng As Range

    Set rng = Range(Cells(4, 3), Cells(4, Columns.Count).End(xlToLeft))

    For i = rng.Count To 1 Step -1

        If Cells(4, i) <> True Then Cells(4, i).EntireColumn.Delete

    Next

End Sub

Τάσος

Γεια
στον κώδικα που σπάει αλλαξε τις 1ες γραμμές πχ
Dim a(100), x, k, m, r, z, i As Integer
Dim t(100, 10000), kol1 As String
θανασης

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

Κώδικας:

Option Explicit
 

Sub sort_true_false()
 

Dim i As Integer

Dim r As Integer

Dim S As Range
 

' "r" is the row number of line with false or true

r = 4

' "S" is the cell where your table starts

Set S = ActiveWorkbook.Worksheets("Sheet1").Range("C3")
 

'Delete Sort keys if they exist and redefine them.

 ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear

 ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range(r & ":" & r), _

    SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal

 

 'Sort horizontaly

 With ActiveWorkbook.Worksheets("Sheet1").Sort

    .SetRange S.CurrentRegion

    .Header = xlYes

    .MatchCase = False

    .Orientation = xlLeftToRight

    .SortMethod = xlPinYin

    .Apply

 End With
 

'Delete columns with False on second row of MyData

For i = Start.Column To S.CurrentRegion.Columns.Count

    If Cells(r, i) = False Then

        Range(Cells(S.Row, i).Address & ":" & _

        Cells(S.Row + S.CurrentRegion.Rows.Count, _

        S.Column + S.CurrentRegion.Columns.Count - 1).Address).Clear

        Exit For

    End If

Next i

End Sub

ΥΓ. Γρηγόρη δεν ξέρω τι λάθος έκανες και το Cut/Paste που σου πρότεινα δεν σου δούλεψε.
Δουλεύει χωρίς βέβαια να είναι ένα κουμπάκι που το κάνει αυτόματα.
Το ξέρω ότι οι αυτοματισμοί απαιτούν λιγότερη προσπάθεια από την πλευρά του χρήστη και πολλοί τους προτιμούν.