Προς το περιεχόμενο

vb και excell


Arioch79

Προτεινόμενες αναρτήσεις

Έχω ένα folder, στο οποίο κάθε μέρα μπαίνουν καινούργια xls αρχεία με την ίδια δομή.

Συγκεκριμένα έχουν δύο γραμμές μόνο, εκ των οποίων η πάνω είναι τα field names (ίδια για όλα τα αρχεία) και η κάτω οι τιμές τους.

Αυτό που θέλω είναι να φτιάξω μία μακροεντολή ή ένα vb script που να παίρνει τις τιμές από όλα τα αρχεία που βρίσκονται σε αυτό το folder και να τις βάζει σε ένα master.xls το οποίο θα έχει επίσης στην πρώτη σειρά τα ίδια field names.

Έχω κατεβάσει μερικές έτοιμες μακροεντολές όπως το merge workbooks ή το synkronizer, αλλά αυτές απλά ενώνουν δύο συγκεκριμένα αρχεία (όχι όλα τα αρχεία του φακέλου) και μάλιστα όχι με τον τρόπο που θέλω.

Δυστυχώς δεν γνωρίζω vb, οπότε είναι δύσκολο για μένα να γράψω ένα script που να κάνει αυτό που θέλω.

Ευχαριστώ προκαταβολικά για την βοήθειά σας.

Συνδέστε για να σχολιάσετε
Κοινοποίηση σε άλλες σελίδες

Κατ' αρχήν η διαδικασία που κάνει τη δουλειά

>
Sub MergeXLS(sfolder As String, sSourceRange As String, sDestColumn As String, _
   Optional nSourceSheet As Integer = 1, Optional nDestSheet As Integer = 1, _
   Optional extension As String = "xls")

Dim fso, fldr, fl
Dim wkb As Workbook
Dim aw As Worksheet
Dim count As Long, countFiles As Long, countTotal As Long
Dim rr As Range

On Error GoTo Failed
' To φύλλο στο οποίο θα εισάγουμε τα δεδομένα
Set aw = Application.ActiveWorkbook.Worksheets(nDestSheet)
countFiles = 0
countTotal = 0
count = 1
' Βρίσκουμε το πρώτο κενό κελί της στήλης sDestColumn αυτού του φύλλου
While (aw.Range(sDestColumn & count).Value <> "")
   count = count + 1
Wend
' Χρησιμοποιούμε το FileSystemObject για να βρούμε τα
' αρχεία που περιέχει ο φάκελος μας
Set fso = CreateObject("Scripting.FileSystemObject")
On Error GoTo Invalid_Path
Set fldr = fso.GetFolder(sfolder)
' Για κάθε αρχείο στο φάκελό μας
For Each fl In fldr.Files
   ' Θέλουμε τα αρχεία με extension xls αλλά όχι τα προσωρινά αρχεία
   ' που δημουργεί το excel και αρχίζουν με ~$
   If (StrComp(fso.GetExtensionName(fl.Name), extension, vbTextCompare) = 0) _
       And (StrComp(Left(fl.Name, 2), "~$") <> 0) Then
       countTotal = countTotal + 1
       On Error GoTo Next_File
       ' Aνοίγουμε το αρχείο μόνο για ανάγνωση
       Set wkb = Workbooks.Open(fl.Path, ReadOnly:=True)
       ' αντιγράφουμε από την περιοχή προέλευσης σε
       ' περιοχή με ίδιο μέγεθος, όπου το πρώτο κελί αριστερά
       ' βρίσκεται στην sDestColumn στήλη και count γραμμή
       wkb.Worksheets(nSourceSheet).Range(sSourceRange).Copy _
           Destination:=aw.Range(sDestColumn & count)
       ' όσες γραμμές έχει η περιοχή που αντιγράφουμε ...
       Set rr = wkb.Worksheets(nSourceSheet).Range(sSourceRange).Rows
       ' ... τόσες γραμμές πάμε κάτω
       count = count + rr.count
       ' κλείνουμε το αρχείο
       wkb.Close SaveChanges:=False
       countFiles = countFiles + 1
   End If
Next_File:
Next
' Αποτέλεσμα διαδικασίας
MsgBox countFiles & " files of total " & countTotal & " merged", _
   vbInformation, "Result"
Exit Sub
Invalid_Path:
   MsgBox "Can't find folder '" & sfolder & "'", vbExclamation, "Aborted"
Exit Sub
Failed:
   MsgBox "Procedure Failed", vbExclamation, "Error"
End Sub

Ένα παράδειγμα κλήσης για να πούμε τι ακριβώς κάνει

>
Sub test()
  MergeXLS "C:\MyXLFiles", "A2:D2", "A", 1, 1, "xls"
End Sub

O "C:\MyXLFiles" είναι ο φάκελος που περιέχει τα αρχεία xls. Η περιοχή "A2:D2" είναι τα κελιά που θα αντιγράψουμε από κάθε αρχείο στο τρέχον workbook. Το "Α" είναι το γράμμα της στήλης στην οποία θα ξεκινά η εισαγωγή των δεδομένων. Το πρώτο 1 δηλώνει το φύλλο του αρχείου από το οποίο πέρνουμε τα δεδομένα και το δεύτερο 1 το φύλλο προορισμού στο τελικό μας xls (δηλ το τρέχον). Το "xls" τέλος δηλώνει το extension των αρχείων που εισάγουμε (το παραμετροποιούμε γιατί στο office07 πχ το default extension είναι xlsx). Με αυτά τα δεδομένα λοιπόν, η MergeXLS καταρχήν θα ψάξει να βρεί το πρώτο κενό κελί στη στήλη A, του πρώτου φύλλου, του αρχείου από το οποίο εκτελείται, για να προσθέσει τα νέα δεδομένα απο κει και κάτω. Έστω ότι αυτό είναι το "Α5". Στο πρώτο xls αρχείο που θα βρει, θα αντιγράψει από το πρώτο φύλλο αυτού του αρχείου την περιοχή "Α2:D2" στην περιοχή "A5:D5" του τρέχοντος αρχείου, στο επόμενο αρχείο την ίδια περιοχή στην "Α6:D6" του τρέχοντος κοκ. Η περιοχή που αντιγράφουμε μπορεί να αποτελείται και απο περισσότερες από μία γραμμές.

Κάτι που είδα τώρα:

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

Συνδέστε για να σχολιάσετε
Κοινοποίηση σε άλλες σελίδες

Φίλε μου, δούλεψε τέλεια! Χίλια ευχαριστώ, δε μπορείς να φανταστείς πόσο χρόνο και διάβασμα μου γλύτωσες! Σου είμαι αιώνια υπόχρεος!

Βέβαια θα κάτσω να μάθω VBA αν και δεν προβλέπεται να μου χρειαστεί στο άμεσο μέλλον. Όμως επειδή έχω αναλάβει τον σχεδιασμό της database της εταιρείας στην οποία εργάζομαι, σίγουρα θα μου λυθούν αρκετά τα χέρια αν μάθω VBA.

Και πάλι χίλια ευχαριστώ για το ενδιαφέρον σου και τον κόπο σου.

Συνδέστε για να σχολιάσετε
Κοινοποίηση σε άλλες σελίδες

Φίλε μου, δούλεψε τέλεια! Χίλια ευχαριστώ, δε μπορείς να φανταστείς πόσο χρόνο και διάβασμα μου γλύτωσες! Σου είμαι αιώνια υπόχρεος!

Βέβαια θα κάτσω να μάθω VBA αν και δεν προβλέπεται να μου χρειαστεί στο άμεσο μέλλον. Όμως επειδή έχω αναλάβει τον σχεδιασμό της database της εταιρείας στην οποία εργάζομαι, σίγουρα θα μου λυθούν αρκετά τα χέρια αν μάθω VBA.

Και πάλι χίλια ευχαριστώ για το ενδιαφέρον σου και τον κόπο σου.

 

Να 'σαι καλά

Δυστυχώς η vba είναι μονόδρομος για scripting στο office. Η μόνη εναλλακτική είναι να χειριστείς τα com αντικείμενα απ' έξω. Καλή συνέχεια κι ότι χρειαστείς εδώ είμαστε...

Συνδέστε για να σχολιάσετε
Κοινοποίηση σε άλλες σελίδες

Αρχειοθετημένο

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

  • Δημιουργία νέου...