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