Δεν τα μεταφέρει με τη σωστή σειρά

[ataskin]

Καλησπέρα στην ομάδα.
Εχω σε φάκελο πολλά pdf αρχεία με αύξουσα σειρά πχ. αρχείο1.pdf,αρχείο2.pdf, αρχείο3.pdf κτλ.
Θέλω να αντιγράψω τα ονόματά τους σε μια στήλη excel.
Δίνω τον παρακάτω κώδικα, αλλά μου βγάζει το αρχείο1.pdf μετά το αρχείο10.pdf,το αρχείο2.pdf μετά το αρχείο20.pdf κτλ. Μπορεί να διορθωθεί ;
Option Explicit
Sub GetFileNames()
Dim xRow As Long
Dim xDirect$, xFname$, InitialFoldr$
InitialFoldr$ = "C:\"
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Επιλέξτε τον φάκελο με την λίστα των αρχείων"
.InitialFileName = InitialFoldr$
.Show
If .SelectedItems.Count <> 0 Then
xDirect$ = .SelectedItems(1) & "\"
xFname$ = Dir(xDirect$, 7)
Do While xFname$ <> ""
ActiveCell.Offset(xRow) = xFname$
xRow = xRow + 1
xFname$ = Dir
Loop
End If
End With
End Sub

[tsgiannis]

Το πρόβλημα σου είναι ότι η Dir διαβάζει και σορτάρει με Text Order ενώ εσυ χρειάζεσαι Numerical Order
Πιθανόν να υπάρχουν και άλλες λύσεις αλλά μια λύση είναι :
Αποθηκεύει την αναζήτηση σε μια δομή...εγώ σκέφτομαι κάτι σε Directory και με αυτό φτιάχνεις 1 Array ...αλλά μπορείς να φτιάξεις και κατευθείαν το Array (Κάνοντας Redim κάθε φορά)
Αυτό το Array το σορτάρεις
https://stackoverflow.com/questions/...-sort-function
Θα χρειαστεί κάποιο tweaking για να κάνεις extract την αριθμητική αξία.

[ChrisGT7]

Καλημέρα Θάνο,

Δοκίμασε τον παρακάτω κώδικα να δεις αν είναι αυτό που ζητάς:

Option Explicit

Sub GetFileNames()
    Dim xRow As Long, xCol As Long, MyCell As String
    Dim xDirect$, xFname$, InitialFoldr$
    InitialFoldr$ = "C:\"
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = Application.DefaultFilePath & "\"
        .Title = "Επιλέξτε το φάκελο με την λίστα των αρχείων"
        .InitialFileName = InitialFoldr$: .Show
        If .SelectedItems.Count = 0 Then Exit Sub
        
        xDirect$ = .SelectedItems(1) & "\"
        xFname$ = Dir(xDirect$, 7)
        Do While xFname$ <> ""
            ActiveCell.Offset(xRow) = xFname$
            ActiveCell.Offset(xRow, 1) = Mid(xFname$, 1, Len(xFname$) - 4)
            xRow = xRow + 1
            xFname$ = Dir
        Loop
        
        xCol = ActiveCell.Column + 2
        xRow = Cells(Rows.Count, xCol - 1).End(xlUp).Row
        MyCell = "OFFSET(INDIRECT(ADDRESS(ROW(),COLUMN())),,-1)"
        Range(Cells(ActiveCell.Row, xCol), Cells(xRow, xCol)).Formula = _
            "=RIGHT(" & MyCell & ",SUM(LEN(" & MyCell & ")-LEN(SUBSTITUTE(" & MyCell & ",{0,1,2,3,4,5,6,7,8,9},""""))))"
        
        Range(Cells(ActiveCell.Row, xCol - 2), Cells(Rows.Count, xCol)).Sort _
            Key1:=Cells(ActiveCell.Row, xCol), Order1:=xlAscending, DataOption1:=xlSortTextAsNumbers
        Range(Cells(ActiveCell.Row, xCol - 1), Cells(Rows.Count, xCol)).ClearContents
    End With
End Sub

Όπως αναφέρει και ο Γιάννης, η ταξινόμηση δε γίνεται σε επίπεδο αριθμού αλλά σε επίπεδο κειμένου, π.χ. το 10 είναι μικρότερο του 2, γιατί συγκρίνεται ένα-ένα ψηφίο και όχι όλος ο αριθμός μαζί.

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

[ataskin]

Καλησπέρα. Χρήστο, στον κώδικα που μου έδωσες φαίνεται πολύ γρήγορα ότι τα βάζει σε μια σειρά, στη συνέχεια τα εξαφανίζει και εμφανίζει αυτή τη συνάρτηση

[ataskin]

=RIGHT(OFFSET(INDIRECT(ADDRESS(ROW();COLUMN()));;-1);SUM(LEN(OFFSET(INDIRECT(ADDRESS(ROW();COLUMN()) );;-1))-LEN(SUBSTITUTE(OFFSET(INDIRECT(ADDRESS(ROW();COLUM N()));;-1);{0\1\2\3\4\5\6\7\8\9};""))))

[ChrisGT7]

Καλησπέρα Θάνο,

Μολις έφτιαξα ένα νέο βιβλίο εργασίας, έτρεξα τον κώδικα και δε βλέπω κάποιο πρόβλημα. Παραμένουν ταξινομημένα τα ονόματα των αρχείων με την κατάληξη μόνο.

Ανάλογα που είναι το τρέχον κελί, μπαίνουν τα ονόματα των αρχείων με την κατάληξη, στη διπλανή στήλη τα ονόματα χωρίς την κατάληξη και πιο δίπλα τα νούμερα.

Έλεγξε αν υπάρχουν παλιά δεδομένα στις διπλανές στήλες που μπορεί να χαλάνε την ταξινόμηση.

[ataskin]

Χρήστο ,Σε ευχαριστώ πολύ. Δουλεύει μια χαρά. Μπράβο Να είσαι πάντα καλά. Το ψάχνω καιρό τώρα, Είσαι φοβερός, Τι να πώ !!!!

[Tasos]

Αγαπητοί φίλοι καλημέρα!

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


Επίσης, αν αυτό επιτρέπεται μπορείτε να μετονομάσετε τα αρχεία σας με μορφή αριθμού 000001.pdf, 000002.pdf κλπ, για να λειτουργήσει η ταξινόμηση κανονικά.

Μέσα στο αρχείο περιέχεται κώδικας που κάνει μαζική μετονομασία αν αυτό είναι επιθυμητό..

Περισσότερες λεπτομέρειες στο αρχείο.

Αν υπάρξει κάποια απορία, παρακαλώ γράψτε στο φόρουμ.

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

Τάσος

[ataskin]

Μπορείτε να μου δώσετε οδηγίες ;
α) που θα τρέξω την εντολή RenameMyFiles().
β) Επίσης που θα τρεξω το Sub RenameMyFiles()
FormatNummericFilenames Foldername:=Range("FolderPath").Value, _
ExtensionName:=Range("FileFilter").Value, _
nFormat:="0000" 'μπορείς να αλλάξεις το μήκος του προθέματος όσο χρειαστεί.

End Sub

Δεν το καταλαβαίνω

[Tasos]

Άνοιξε το αρχείο που επισυνάπτω και πάτησε το κουμπί: Μετονομασία αρχείων...
Στο διάλογο που θα εμφανιστεί επίλεξε

1. Τον φάκελο με τα PDF
2. Τον φάκελο που θα αντιγραφούν τα αρχεία με το νέο όνομα.

Πάτησε "Μετονομασία"

Αφού μετονομαστούν τα αρχεία σου με επιτυχία θα ανοίξει ο φάκελος που τα περιέχει.


Κατόπιν συμπλήρωσε στο κελί Β1 του αρχείου από το προηγούμενο μου μήνυμα τη διαδρομή του φακέλου που περιέχει τα αρχεία με το νέο όνομα.

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

Τάσος