Θέμα: Γενικά Φίλτρο με TRUE,FALSE

Εμφάνιση ενός μόνο μηνύματος
  #20  
Παλιά 27-09-12, 19:11
Το avatar του χρήστη gr8styl
gr8styl Ο χρήστης gr8styl δεν είναι συνδεδεμένος
Super Moderator
Όνομα: Θανάσης Στυλιανίδης
Έκδοση λογισμικού Office: Ms-Office 2003, Ms-Office 2010
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 18-10-2009
Περιοχή: Βρυξέλλες, Βέλγιο
Μηνύματα: 758
Προεπιλογή

Έτσι που εξελίχθηκε το θέμα όπως είπε και ο Τάσος,
θα έλεγα γιατί δεν χρησιμοποιούμε απλά οριζόντια ταξινόμηση με κλειδί την γραμμή 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 που σου πρότεινα δεν σου δούλεψε.
Δουλεύει χωρίς βέβαια να είναι ένα κουμπάκι που το κάνει αυτόματα.
Το ξέρω ότι οι αυτοματισμοί απαιτούν λιγότερη προσπάθεια από την πλευρά του χρήστη και πολλοί τους προτιμούν.