[Γενικά] Πρόβλημα με πολλαπλό save σε .csv

[nikosjc]

Μιας και γράφτηκα στο forum λέω να εκφράσω σήμερα όλες μου τις απορίες και προβλήματα!!!

Έχω φτιάξει μια μακροεντολή που παίρνει δεδομένα από ένα φύλλο και δημιουργεί αρκετά άλλα φύλλα με κάποιες από τις τιμές του πρώτου. Τα δεδομένα αυτά τα βάζει σε διάφορες στήλες στο κάθε φύλλο. Οι στήλες στα νέα φύλλα δεν γεμίζουν όλες αλλά μόνο κάποιες, πχ οι D,E,H,K και L. Οι υπόλοιπες μένουν κενές.

Εγώ χρειάζομαι αυτά τα νέα φύλλα να τα σώνω ένα-ένα σε μορφή .csv. Έτσι, για να γίνεται "αυτόματα" το save, πρόσθεσα μέσα στην Μακροεντολή σε μια ρουτίνα επαναληψης που έχω για να κάνει την αντιγραφή των δεδομένων σε κάθε φύλλο, το εξής:

μια μεταβλητή που διαβάζει το όνομα του κάθε φύλλου...
name = Worksheets(1).Cells(1, j)

και τον κώδικα για την αποθήκευση του κάθε φύλλου με την αντίστοιχη ονομασία...
ActiveWorkbook.SaveAs Filename:="E:\Save" + name + ".csv", _
FileFormat:=xlCSV, CreateBackup:=False

Ποιο είναι το πρόβλημα όμως. Ενώ αν δεν έχω το αυτόματο save, αλλά πηγαίνω σε κάθε φύλλο και το σώνω ένα-ένα όλα πηγαίνουν -σχεδόν- ρολόι και το csv σώνεται κανονικά (όταν το ανοίγω και πάλι με το excel είναι όλα στην σωστή θέση), όταν κάνω το αυτόματο save, ενώ τα σώνει όλα μαζί, δυστυχώς δεν τα σώνει σωστά. Δηλαδή μαζεύει όλες τις πληροφορίες κάθε γραμμής στην πρώτη στήλη (Α) σε αυτή τη μορφή:
Πχ. Ροδέλα Μ25x1,5 - PG11,,,,,1,0501-07-1125,,,,,1,,,,25/02/2011
πράγμα που στη συνέχεια μου προκαλεί προβλήματα.

Το "-σχεδόν- ρολόι" πήγαινε στο άλλο προβληματάκι που αντιμετωπίσω. Σε κάποιες περιπτώσεις (δεν έχω καταλάβει πως και γιατί) ακόμα και στο σώσιμο κάθε φύλλου ξεχωριστά (χειροκίνητα), μπορεί να μου κρατάει τις στήλες όπως θα έπρεπε να είναι, αλλά αντί να ξεκινάνε από την στήλη D ας πούμε που είναι η πρώτη με δεδομένα (γιατί θέλω τις προηγούμενες κενές), μετά από το save τα δεδομένα ξεκινάνε από τη στήλη Α. Για αυτό έχω προσπαθήσει τουλάχιστον στην πρώτη γραμμή και στην πρώτη στήλη (Α1) να κάνω εισαγωγή απλά ενός κενού " ", και έτσι διορθώνεται το πρόβλημα.

Είναι λίγο ειδική περίπτωση, αν κάποιος γνωρίζει κάτι ας βοηθήσει please...

Ευχαριστώ!

[Tasos]

Νίκο καλησπέρα!

Έχει σημασία το τί διαχωριστικό που χρησιμοποιείται κατά την αποθήκευση.
Αλλιώς θα διαβαστεί από υπολογιστή που χρησιμοποιεί διαχωριστικό το κόμμα
(συνήθως αγγλοαμερικανικό) και αλλιώς από άλλον που χρησιμοποιεί ερωτηματικό (semicolon).

Θα μπορέσουμε να σου απαντήσουμε με ακρίβεια αν επισυνάψεις ένα παράδειγμα για να έχουμε μια πιο πλήρη εικόνα του προβλήματος.
Φιλικά

Τάσος

[nikosjc]

Καλημέρα,

επισυνάπτω το excel με την μακροεντολή που αναφέρω παραπάνω.

Τρέχοντας την macro δημιουργεί νέα φύλλα όπου τα ονοματίζει με την επικεφαλίδα κάθε Κωδικού (Α1256,...) (στήλες G,H,I,J,κλπ) και μεταφέρει μόνο τα υλικά που έχουν ποσότητες στο κάθε φύλλο αναλόγως το Κωδικό. Τα δεδομένα που μεταφέρει (ή δημιουργεί) πρέπει να βρίσκονται στις συγκεκριμένες στήλες. Όταν γίνεται αυτόματο save σε csv έτσι όπως το έγω γράψει δυστυχώς τα μεταφέρει όλα στην στήλη Α με την μορφή που αναφέρω παραπάνω.

(To save το κάνει σε έναν φάκελο C:\macro\...)

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

[Tasos]

Καλησπέρα Νίκο!

Θέλεις να εξαγεις δηλαδή 4 διαφορετικά αρχεία *.csv, ένα για κάθε κωδικό (στήλες G,H,I,J)
που να περιέχουν:
[Α/Α], [ΠΕΡΙΓΡΑΦΗ], [ΚΩΔΙΚΟΣ ΥΛΙΚΟΥ], [ΚΩΔΙΚΟΣ], [Ημερομηνία], [TOTAL 3], [Κωδικός (στήλες G,H,I,J, μια κάθε φορά)];

Φιλικά

Τάσος

[nikosjc]

Να το εξηγήσω λίγο καλύτερα. Υπάρχει ήδη το πρώτο φύλλο ως φόρμα όπου περνάω τα υλικά με τα στοιχεία τους, εως την στήλη Ε ουσιαστικά. [Α/Α], [ΠΕΡΙΓΡΑΦΗ], [ΚΩΔΙΚΟΣ ΥΛΙΚΟΥ], [ΚΩΔΙΚΟΣ], [Ημερομηνία]

Μετά χειροκίνητα αναλόγως τους πόσους κωδικούς έχω (μπορεί να είναι πάνω από τέσσερις), συμπληρώνω από την στήλη G και μετά... [Α1256],[Α1257],[...] και τις ποσότητες προς τα κάτω.
Στην στήλη F [TOTAL 3] βγάζει αυτόματα το σύνολο των ποσοτήτων για κάθε ανταλλακτικό από όλα τα έργα (στο excelάκι που έχω ανεβάσει έχει χαθεί η συνάρτηση αλλά δεν έχει σημασία) και μετά τρέχοντας την μακροεντολή, διαβάζει την κάθε στήλη από G και μετά και ανοίγει νέα φύλλα με το όνομα του κάθε Κωδικού (Α1256, 57...). Αντιγράφει τις ποσότητες, την περιγραφή και κάποιες άλλες στήλες του Φύλλου1 (Ylika) στα επόμενα αντίστοιχα φύλλα σε συγκεκριμένες στήλες και σώνει το κάθε νέο φύλλο σε αντίστοιχα .csv αρχεία. Ταυτόχρονα γίνονται και άλλα δύο saves, ένα με το πρωτότυπο αρχείο πριν αρχίσει η macro (original) και ένα μόλις τρέξει η macro (teliko).

Όλα πάνε καλά, απλά το csv που μου δημιουργεί δεν είναι όπως όταν το σώνω από μόνο του, δεν μου κρατάει τις σωστές στήλες που μου είναι απαραίτητο.

Στην ουσία κάτι τρέχει με το save που κάνω, ίσως θέλει κάποια παράμετρο που δεν γνωρίζω (;)

ActiveWorkbook.SaveAs Filename:="C:\Macro\Teliko.xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False

[Tasos]

Φίλε Νίκο,
ο παρακάτω κώδικας

• Παίρνει τις στήλες: [Α/Α], [ΠΕΡΙΓΡΑΦΗ], [ΚΩΔΙΚΟΣ ΥΛΙΚΟΥ], [ΚΩΔΙΚΟΣ], [Ημερομηνία]
  καθώς και τη στήλη [Κωδικός (στήλες G,H,I,J, μια κάθε φορά)] και μόνον εκείνες τις γραμμές που ο κώδικας (πχ. A1256 ) δεν είναι μηδέν.
• Τις αποθηκεύει σε μορφή Unicode προσθέτοντας και την ημερομηνία και ώρα σε
  μορφή που να είναι αποδεκτή από τα Windows.
  Οι στήλες διαχωρίζονται με Tab για περισσότερη συμβατότητα.
• Εξάγει το τρέχον φύλλο σε νέο βιβλίο, μετατρέπει τυχόν τύπους σε σταθερές τιμές
  και αποθηκεύει το νέο αυτό βιβλίο στον ίδιο φάκελο με τα *.csv.

Option Explicit
Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
                                             ByVal lpPath As String) As Long

Const ThePath = "C:\Data\"    'Το όνομα του φακέλου

Sub Export2csv()
    Dim rng As Range, rngRow As Range, c As Range, _
        d As Range, strCSV As String, _
        tmpString As String, fso As Object, _
        oStream As Object, i As Integer, _
        r As Long, RowsCount As Long

    MakeSureDirectoryPathExists "C:\Data\"

    With Application
        .ScreenUpdating = False

        r = Range("A" & Rows.Count).End(xlUp).Row
        Set rng = Range("A1:E" & r)
        RowsCount = rng.Rows.Count
        For i = Range("G1").Column To Range("G1").End(xlToRight).Column 'όλοι οι κωδικοί από το G1 έως τον τελευταίο
            Set d = Range(Cells(1, i), Cells(RowsCount, i))
            For r = 1 To RowsCount
                Set rngRow = rng.Rows(r)
                If d(r) <> 0 Then
                    For Each c In rngRow.Cells
                        tmpString = tmpString & c.Text & vbTab
                    Next
                    tmpString = tmpString & d(r).Text & vbNewLine
                    strCSV = strCSV & tmpString
                    tmpString = vbNullString
                End If
            Next
            tmpString = Cells(1, i) & "_" & Replace(Format(Now, "dd_mm_yy hh:mm:ss"), ":", "_") & ".csv"
            Set fso = CreateObject("Scripting.FileSystemObject")
            Set oStream = fso.CreateTextFile(ThePath & tmpString, True, True)
            oStream.Write strCSV
            oStream.Close
            Set fso = Nothing
            strCSV = vbNullString
            tmpString = vbNullString
        Next

        tmpString = ThePath & "All_" & Replace(Format(Now, "dd_mm_yy hh:mm:ss"), ":", "_") & ".xls"
        ActiveSheet.Copy
        ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
        ActiveWorkbook.SaveAs tmpString, ThisWorkbook.FileFormat
        ActiveWorkbook.Close , False
        .ScreenUpdating = True
    End With
End Sub

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

Τάσος

[nikosjc]

Καλημέρα Τάσο,

χίλια ευχαριστώ για την προσπάθεια σου! Είναι πολύ καλή δουλειά, πολύ κοντά σε αυτό που θα ήθελα, αλλά δυστυχώς όχι ακριβώς αυτό!

Επειδή πιάσαμε τα δύσκολα, και τον κώδικα ζορίζομαι να τον διαβάσω (θα μπορούσες να γράφεις κάποια σχολιάκια δίπλα ως επεξήγηση?) και να τον παραμετροποιήσω, έτσι θα ήθελα μερικές αλλαγούλες αν δεν σου είναι δύσκολο.

Στο csv θα ήθελα να είναι:
η ΠΕΡΙΓΡΑΦΗ στην Στήλη C (αντί για B)
η Ποσότητα για κάθε Κωδικό(A1256...) στην Στήλη Η (αντί για F)
ο ΚΩΔΙΚΟΣ στην Στήλη Ι (αντί για στήλη C)
η ΗΜ/ΝΙΑ στην Στήλη R (αντί για στήλη Ε)
και τέλος στην στήλη Ν να υπάρχει παντού (για όσες γραμμές έχω υλικά) το 1

Ο Α/Α και ο ΚΩΔΙΚΟΣ ΥΛΙΚΟΥ δεν μου χρειάζονται και όλες οι άλλες στήλες θα ήθελα να είναι κενές. Επίσης θα ήθελα στα csv να ΜΗΝ έχει επικεφαλίδες, αλλά μόνο τα δεδομένα. Το αρχείο αυτό γίνεται εισαγωγή σε κάποιο πρόγραμμα που θέλει τη συγκεκριμένη μορφοποίηση.

Συγνώμη αν γίνομαι κουραστικός, ότι σου είναι εύκολο κάνε, εγώ σου είμαι ήδη ευγνώμον!!!!

[Tasos]

Καλημέρα Νίκο!

Βάλε σε παρακαλώ τα ονόματα των στηλών σε πλαίσια [ ] όπως θα φαίνονται στο *.csv
για να δούμε την ακριβή διάταξη.
Αν μεσολαβούν κενές στήλες γράψε [κενή] .
Φιλικά

Τάσος

[nikosjc]

Κατ'αρχήν επειδή γεμίσαμε κωδικούς να τα ξεκαθαρίσουμε λίγο:
Κωδικός Υλικού - Δεν χρειάζεται
ΚΩΔΙΚΟΣ - είναι ο Κωδικός του ανταλλακτικού
ΠΟΣΟΤΗΤΑ - Είναι αυτό που λέμε Κωδικός Α1256, 57, που στην ουσία η στήλη έχει μεν ως επικεφαλίδα τον Κωδικό (ενός έργου), αλλά απο κάτω έχει την ποσότητα κάθε ανταλλακτικού για το κάθε έργο. Αυτό που στο πρώτο φύλλο (στην φόρμα μου) είναι στις στήλες G,H,I,κλπ.

Λοιπόν, το csv θέλω να περιέχει:

Α:[Κενό], Β:[Κενό], C:[ΠΕΡΙΓΡΑΦΗ], D:[Κενό], E:[Κενό], F:[Κενό], G:[Κενό], H:[Ποσότητα], I:[Κωδικός], J:[Κενό], K:[Κενό], L:[Κενό], M:[Κενό], N:[τον αριθμό 1], O:[Κενό], P:[Κενό], Q:[Κενό], R:[Ημερομηνία], S:[Κενό],... [Κενά...]
Όλα τα παραπάνω χωρίς να έχουν επικεφαλίδα στην πρώτη σειρά.

Ανεβάζω μια φώτο (δεν με αφήνει να ανεβάσω το csv) με το πως είναι το σωστό όταν τα εξάγω ένα-ένα από τον δικό μου αρχείο. Μόλις δλδ δημιουργηθούν τα νέα φύλλα όπως τα θέλω, πάω σε ένα-ένα χειροκίνητα και κάνω save as... CSV (Οριοθετημένο με κόμματα) (*.csv).

Να τονίσω ότι για να μου το βγάλει σωστά με τις στήλες όπως τα θέλω πρέπει πρώτα να κάνω απλά ένα διπλό κλικ στο κελί Α1 (δεν ξέρω, ίσως για να φαίνεται ότι έχει επεξεργαστει?) και μετά να σώσω, γιατί αλλιώς στο csv που εξάγει ξεκινάει την [ΠΕΡΙΓΡΑΦΗ] από την στήλη Α και όχι από την C όπως τη θέλω...

[Tasos]

Καλησπέρα Νίκο!
Ήσουν κατατοπιστικότατος!
Με κάποιες αλλαγές που έγιναν πιστεύω να σε εξυπηρετεί ο παρακάτω κώδικας:

Option Explicit

Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
                                             ByVal lpPath As String) As Long

Const ThePath = "C:\Data\"    'Το όνομα του φακέλου

Sub Export2csv()
    Dim rng As Range, d As Range, strCSV As String, tmpString As String, fso As Object, _
        oStream As Object, i As Integer, r As Long, RowsCount As Long, _
        c4Seperator As String, c3Seperator As String, c2Seperator As String, cSeperator As String

    'Αν χρησιμοποιηθεί το σύμβολο ";" ως οριοθέτης,
    'θα πρέπει να αφαιρεθεί το τελευταίο "True" από τη γραμμή "Set oStream =..."
    c4Seperator = vbTab & vbTab & vbTab & vbTab & vbTab  '";;;;"
    c3Seperator = vbTab & vbTab & vbTab & vbTab    '";;;"
    c2Seperator = vbTab & vbTab    '";;" '
    cSeperator = vbTab    '";"
    MakeSureDirectoryPathExists "C:\Data\"

    With Application
        .ScreenUpdating = False

        r = Range("B" & Rows.Count).End(xlUp).Row
        Set rng = Range("B2:B" & r)
        RowsCount = rng.Rows.Count

        For i = Range("G1").Column To Range("G1").End(xlToRight).Column    'όλοι οι κωδικοί από το G1 έως τον τελευταίο
            Set d = Range(Cells(2, i), Cells(RowsCount, i))
        '   d.Select
            For r = 1 To RowsCount
                If d(r) <> 0 Then
                    tmpString = _
                    c2Seperator & _
                                rng(r).Text & _
                                c4Seperator & _
                                d(r).Text & _
                                cSeperator & _
                                rng(r).Offset(, 2).Text & _
                                c4Seperator & _
                              1 & _
                                c3Seperator & _
                                rng(r).Offset(, 3).Text & _
                                vbNewLine
                    strCSV = strCSV & tmpString
                    tmpString = vbNullString
                End If
            Next
            tmpString = Cells(1, i) & "_" & Replace(Format(Now, "dd_mm_yy hh:mm:ss"), ":", "_") & ".csv"
            Set fso = CreateObject("Scripting.FileSystemObject")

            'Αν χρησιμοποιηθεί το σύμβολο ";" ως οριοθέτης,θα πρέπει να αφαιρεθεί το τελευταίο "True"
            Set oStream = fso.CreateTextFile(ThePath & tmpString, True, True)
            oStream.Write strCSV
            oStream.Close
            Set fso = Nothing
            strCSV = vbNullString
            tmpString = vbNullString
        Next

        tmpString = ThePath & "All_" & Replace(Format(Now, "dd_mm_yy hh:mm:ss"), ":", "_") & ".xls"
        ActiveSheet.Copy
        ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
        ActiveWorkbook.SaveAs tmpString, ThisWorkbook.FileFormat
        ActiveWorkbook.Close , False
        .ScreenUpdating = True
    End With
End Sub

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

Τάσος