Αποθήκευση εύρους σε αρχείο CSV
Λύση #670 για τον τρόπο εξαγωγής εύρους σε οριοθετημένο αρχείο κειμένου.
Αυτή είναι μια εύχρηστη εναλλακτική λύση για να χρησιμοποιήσετε τον προεπιλεγμένο τρόπο του Excel για να αποθηκεύσετε το φύλλο εργασίας ως αρχείο κειμένου ή ως αρχείο οριοθετημένο με CSV, επιλέγοντας "αποθήκευση ως" όταν:
1. Χρησιμοποιείτε ένα πρότυπο και θέλετε να εξάγετε μόνο τα δεδομένα, εξαιρουμένων των κεφαλίδων και άλλων ειδών
2. Ομοίως, μπορεί να θέλετε να εξάγετε μόνο ένα μέρος ενός συνόλου δεδομένων
3. Θέλετε να αποθηκεύσετε το αρχείο με έναν προσαρμοσμένο οριοθέτη που μπορεί να είναι μοναδικός για την εφαρμογή σας.
Εάν χρειάζεστε να κάνετε 1,2 ή 3, μια λειτουργία όπως η παρακάτω μπορεί να σας βοηθήσει. Δέχεται ένα εύρος για εξαγωγή, τοποθεσία για αποθήκευση του αρχείου και τον οριοθέτη με τον οποίο θέλετε να διαχωριστούν τα δεδομένα σας και, στη συνέχεια, αποθηκεύει τα δεδομένα σας όπως καθορίζεται.
Δείτε πώς μπορείτε να καλέσετε τη συνάρτηση ExportRange:
| 1234567891011 | Sub CallExport ()'ExportRange (εύρος, όπου, οριοθέτης)Κλήση ExportRange (Sheet1.Range ("A1: C20"), _"C: mark.txt", ",")Τέλος υπο |
Πρώτα λέτε στη συνάρτηση το εύρος που θέλετε να εξαγάγετε και, στη συνέχεια, πού να το εξάγετε, από το όριο που θα χρησιμοποιήσετε. Θα χρειαστείτε επίσης τη λειτουργία ExportRange, εδώ είναι:
| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263 | Function ExportRange (WhatRange As Range, _Where As String, Delimiter As String) As StringΔοκιμή Dim HoldRow As Long για νέα μεταβλητή σειράςHoldRow = WhatRange.RowDim c As Range 'loop through range variableΓια κάθε γ στο WhatRangeΑν HoldRow c.Row Τότε"προσθέστε το linebreak και αφαιρέστε το επιπλέον delimeterExportRange = Αριστερά (ExportRange, Len (ExportRange) - 1) _& vbCrLf & c. Text & DelimiterHoldRow = γ. ΣειράΑλλούExportRange = ExportRange & c. Text & DelimiterΤέλος εανΕπόμενο γ«Περικοπή επιπλέον οριοθέτηExportRange = Αριστερά (ExportRange, Len (ExportRange) - 1)«Σκοτώστε το αρχείο εάν υπάρχει ήδηΑν Len (Dir (Πού))> 0 ΤότεKill WhereΤέλος εανΆνοιγμα Where For Append As #1 'γράψτε το νέο αρχείοΕκτύπωση #1, ExportRangeΚλείσιμο #1Λειτουργία Τέλους |
