Forum

Forum (https://www.ms-office.gr/forum/)
-   Excel - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/)
-   -   Δεν τα μεταφέρει με τη σωστή σειρά (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/5727-den-ta-metaferei-me-ti-sosti-seira.html)

ataskin 13-12-20 23:53

Δεν τα μεταφέρει με τη σωστή σειρά
 
Καλησπέρα στην ομάδα.
Εχω σε φάκελο πολλά 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 15-12-20 08:32

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

ChrisGT7 15-12-20 09:49

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

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

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 15-12-20 21:13

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

ataskin 15-12-20 21:14

=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 15-12-20 23:15

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

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

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

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

ataskin 15-12-20 23:59

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

Tasos 16-12-20 05:04

1 Συνημμένο(α)
Αγαπητοί φίλοι καλημέρα!

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


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

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

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

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

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

Τάσος

ataskin 16-12-20 20:59

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

End Sub

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

Tasos 17-12-20 15:47

1 Συνημμένο(α)
Άνοιξε το αρχείο που επισυνάπτω και πάτησε το κουμπί: Μετονομασία αρχείων...
Στο διάλογο που θα εμφανιστεί επίλεξε
  1. Τον φάκελο με τα PDF
  2. Τον φάκελο που θα αντιγραφούν τα αρχεία με το νέο όνομα.
Πάτησε "Μετονομασία"

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


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

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

Τάσος


Η ώρα είναι 15:49.

Ms-Office.gr - ©2000 - 2026, Jelsoft Enterprises Ltd.


Search Engine Optimization by vBSEO 3.3.2