Ταξινόμιση στο Excel

[Jikail]

Έχω ένα αρχείο excel το οποίο έχει στην πρώτη στήλη όνομα και στη δεύτερη κινητό τηλέφωνο.. Μερικές εγγραφές έχουν 2-3 τηλέφωνα σε διαφορετικές γραμμές καταχωρημένα.. Εκείνο που θέλω να κάνω είναι να ταξινομήσω με βάση το όνομα και οι υπόλοιπες εγγραφές να μπουν στη σωστή θέση.. Έχω ανεβάσει και ένα αρχείο για να καταλάβετε τι εννοώ.. Η αριστερή στήλη είναι η αρχική και η δεξιά είναι το επιθυμιτό τελικό αποτέλεσμα..

taksinomisi.zip

[silverthan]

Μήπως να έβαζες τα τηλέφωνα στο ίδιο shell?

Μετά κάνεις Data->Sort

[kleidokratwr]

Καλύτερα βάλε το δεύτερο τηλέφωνο απο τον καθένα σε μια τρίτη, τέταρτη, κτλ κτλ στήλη.

πχ:

Μήτσος | Τηλ1 | τηλ2 | Τηλ3 |

Τάκης | Τηλ1 | Τηλ2 |

Γιώργος| τηλ1 |

Γιάννης | Τηλ1 | Τηλ2 |

 

Για ταξίνόμηση [στην περίπτωση που δεν θυμάσαι] επιλέγεις την στήλη σύμφωνα με την οποία θέλεις να ταξινομήσεις και αφου πατήσεις το κουμπάκι της ταξινόμησης του λες να επεκτείνει και στα υπόλοιπα κελια.

[Jikail]

Το θέμα είναι ότι μπορεί εκτός απο τηλέφωνα να υπάρχουν και διευθύνσεις κτλ που θα πιάνουν περισσότερες από μια γραμμές.. Θέλω με κάποι τρόπο να 'κλειδωσω' κάθε εγγραφή ώστε στην ταξινόμηση να μετακινείται όλη μαζί..

[kounoupi]

Στο παράδειγμα σου ή ταξινόμηση που θες είναι λάθος, προφανώς θες πρώτα το Lemonis και μετά το Manolis

 

Λοιπόν:

Στήλη Α ονόματα

Στήλη Β τηλέφωνα ή ότι άλλο

 

-----------------------------

Sub My_order()

Dim lastrow As Integer

Dim findstr As Integer

findstr = 1

 

Range("B1").Select

lastrow = Selection.SpecialCells(xlCellTypeLastCell).Row

 

Range("A1").Select

Do

Do

If IsEmpty(ActiveCell) = False Then

ActiveCell.Offset(1, 0).Select

End If

Loop Until IsEmpty(ActiveCell) = True

ActiveCell.Value = ActiveCell.Offset(-1, 0).Value + "-"

Loop Until ActiveCell.Row = lastrow

 

Columns("A:B").Select

Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _

OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

DataOption1:=xlSortNormal

Range("A1").Select

For findstr = 1 To lastrow Step 1

If Cells(findstr, 1).Value Like "*-*" Then Cells(findstr, 1).ClearContents

Next findstr

End Sub

[Jikail]

Πέρασα το παραπάνω σαν μακροεντολή αλλά δεν κάνει δουλειά.. Πέφτει σε loop και επειδή δεν σκαμπάζω από αυτά δεν μπορώ να το διορθώσω.. Το πρόβλημα υπάρχει στο

> Loop Until ActiveCell.Row = lastrow

[kounoupi]

Δες το excel

taksinomisi.zip

[kounoupi]

>.....
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value + "[color=Red][b]-[/b][/color]"
.....
If Cells(findstr, 1).Value Like "*[color=Red][b]-[/b][/color]*" Then 
.....

 

Χαίρομαι που βοήθησα :grin: απλά να σου πω ότι όταν στα ονοματά σου έχεις παύλα (μόνο στα ονόματα) το παραπάνω δεν παίζει σωστά, θα πρέπει να αλλάξεις τα κόκκινα με κάτι ίδιο,πχ. #,$ κτλ

[Jikail]

Κατάλαβα.. Ευχαριστώ πολύ..