Forum

Forum (https://www.ms-office.gr/forum/)
-   Excel - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/)
-   -   [VBA] Εισαγωγή δεδομένων από άλλο αρχείο excel (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/6018-eisagogi-dedomenon-apo-allo-arxeio-excel.html)

agrbita 21-12-21 16:17

Εισαγωγή δεδομένων από άλλο αρχείο excel
 
Κύριοι καλησπέρα σας,

Επανέρχομαι με νέο θέμα καθώς έκανα νέο σχεδιασμό στο project μου.

Τα δεδομένα μου :
1ον. Έχω το αρχείο ΤΑ6.1.xlsx, όπου υπάρχουν δεκατέσσερα φύλλα δεδομένων (αλφαρηθμητικά χωρίς συναρτήσεις). Στο κάθε φύλλο έχουμε σταθερά, 22 στήλες και 5500 γραμμές. Το όνομα του κάθε φύλλου είναι RF1,RF2, ... RF14. είναι μεγάλο αρχείο και αργεί να ανοίξει.
2ον. Έχω φτιάξει ένα νέο αρχείο DEMO1.xlsx όπου αντλώντας δεδομένα από το ΤΑ6.1.xlsx κάνω υπολογισμούς.
Στο αρχείο DEMO!.xlsx υπάρχουν 4 φύλλα (XMLi, ΥΦΙΣΤΑΜΕΝΗ, ΜΕΛΛΟΝΤΙΚΗ, ΒΑΘΜΟΛΟΓΙΑ και Φύλλο1).
Στο Φύλλο ΥΦΙΣΤΑΜΕΝΗ στο κελί L2, έχω λίστα όπου υπάρχουν τα ονόματα των φύλλων του ΤΑ6.1.xlsx (RF1, RF2, ... RF14).
Επίσης στο κελί Ρ1 εμφανίζεται η διαδρομή του C:\....\ΤΑ6.1.xlsx\&L2&.

Ενέργειες που κάνω μέχρι τώρα. Εφόσον επιλέγω από την λίστα (στο κελί L2) το φύλλο RF(!)
Κάνω Αντιγραφή / Επικόλληση των δεδομένων από το αρχείο ΤΑ6.1.xlsx του φύλλου RF(!) στο Φύλλο1 του αρχείου DEMO1.xlsx.(Ctr +Shtt + End μετά Ctr + C και μετά Ctr + V)

Το ερώτημα τώρα.

1ον. Υπάρχει τρόπος με χρήση VBA να αυτοματοποιήσω την διαδικασία;
2ον. Υπάρχει η δυνατότητα χωρίς να ανοίγω το αρχείο (στο παρασκήνιο) να παίρνω τα δεδομένα που θέλω;
3ον. Είναι καλύτερα να αντιγράφω όλο το φύλλο που ζητώ;

kapetang 21-12-21 22:50

Καλησπέρα

Θα πρότεινα να δοκιμάσεις το εξής.

1) Κάθε φύλλο του ΤΑ6.1.xlsx να γίνει ξεχωριστό βιβλίο (14 βιβλία).

2) Ανάλογα με την τιμή του L2 να φορτώνεται και το κατάλληλο βιβλίο.

Βολεύει, στη διαμόρφωση του τύπου με την INDIRECT, κάθε βιβλίο να έχει το όνομα του φύλλου του (RF1, RF2, ...,RF14) και όλα να είναι στον ίδιο φάκελο.

agrbita 24-12-21 21:36

Κύριε Γιώργο, ευχαριστώ για την συμβουλή σου. Ξέρω ότι θα δουλέψει, όμως με ανοιχτά αρχεία.
Αυτό όμως που θέλω, είναι να κατακτήσω αυτό που έχω βάλει ως στόχο.
Έτσι λοιπόν, θα διαβάσω, θα πειραματιστώ και θα προσπαθήσω πετύχω το αποτέλεσμα που ζητώ.
Θα λύσω το πρόβλημά μου με VBA.

Πιστεύω ότι το μυαλό μπορεί να κατακτήσει πάρα πολλά. Και αν αποτύχει, τότε έχει μάθει πολλά.
Χρόνια Πολλά

kapetang 25-12-21 09:20

Εύχομαι να κατακτήσεις τους στόχους σου.

Χρόνια πολλά, με υγεία.

agrbita 26-12-21 15:58

Καλησπέρα και χρόνια πολλά.

Κύριε Γιώργο με την συμβουλή σου σου να δημιουργήσω, τόσα αρχεία όσα και αυτά που είναι στα φύλλα αυτού του μεγάλου αρχείου ΕΛΥΣΑ το ζητούμενο.
Αναλυτικά λοιπόν αναφέρω ότι δημιούργησα 14 αρχεία με ένα φύλλο το καθένα (εννοώ το φύλλο RF1, RF2 ... RF14). Το όνομα του κάθε φύλλου είναι αυτό που υπάρχει στην λίστα του κελιού L2. Στο κελί Α1 του φύλλου "ΥΦΙΣΤΑΜΕΝΗ" έχω βάλει την συνάρτηση ="G:\Το Drive μου\ΜΕΤΡΟ 6.1 ΝΕΟΙ ΑΓΡΟΤΕΣ\"&L2&".xlsx"
Στην συνέχεια εκτελώ την μακροεντολή :

Sub COPY_1()

Dim wkb1 As Workbook
Dim sht1 As Worksheet
Dim wkb2 As Workbook
Dim sht2 As Worksheet

Sheets("Φύλλο1").Select 'Διαγραφή των δεδομένων του Φύλλο1
Range(Selection, "a1:x5500").Select
Selection.ClearContents


Application.ScreenUpdating = False

Set wkb1 = ThisWorkbook

Set wkb2 = Workbooks.Open(Filename:=wkb1.Worksheets("ΥΦΙΣ ΤΑΜΕΝΗ").Range("a1").Value)

Set sht1 = wkb2.Sheets(1)
Set sht2 = wkb1.Sheets("Φύλλο1")

sht1.Cells.Copy
sht2.Range("a1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
wkb2.Close True

Sheets("Φύλλο1").Select
Range("a1").Select

Sheets("ΥΦΙΣΤΑΜΕΝΗ").Select
Range("a1").Select


Application.ScreenUpdating = True

End Sub

Η Μακροεντολή αυτή αντιγράφει το ένα και μοναδικό φύλλο, από το κλειστό αρχείο (RF1, RF2, κλπ) με κατάληξη (*.xlsx) στο Φύλλο1 του αρχείου που εργάζομαι αφού πρώτα διαγράψει τα δεδομένα του Φύλλου1 .
Διορθώσεις και παρατηρήσεις δεκτές
Χρόνια Πολλά, υγεία και χαρά.

kapetang 26-12-21 21:03

Καλησπέρα

1) Δοκίμασε τον κώδικα που είναι συντομότερος και μάλλον ταχύτερος.
Κώδικας:

Sub COPY_1()

    Dim wkb1 As Workbook
    Dim sht1 As Worksheet
    Dim wkb2 As Workbook
    Dim sht2 As Worksheet

    Application.ScreenUpdating = False

    Set wkb1 = ThisWorkbook

    Set wkb2 = Workbooks.Open(Filename:=wkb1.Worksheets("ΥΦΙΣ ΤΑΜΕΝΗ").Range("a1").Value)

    Set sht1 = wkb2.Sheets(1)
    Set sht2 = wkb1.Sheets("Φύλλο1")
    sht2.Range("a1:x5500").Value = sht1.Range("a1:x5500").Value
   
    wkb2.Close False

    Sheets("ΥΦΙΣΤΑΜΕΝΗ").Select
    Range("a1").Select


    Application.ScreenUpdating = True

End Sub

2) Με τον κώδικα τα αρχεία RF1, RF2, ... ανοίγουν (φορτώνονται) στο Excel και έτσι γίνεται δυνατή η αντιγραφή των στοιχείων τους στο φύλλο1.

agrbita 26-12-21 23:01

Κύριε Γιώργο καλησπέρα σας και ευχαριστώ για την πολύτιμη βοήθειά σας.
Με σπρώξατε να μάθω κάτι που έλεγα, δεν έχω τις γνώσεις να τα καταφέρω. Αυτός ο κώδικας πράγματι είναι πολύ ποιο γρήγορος.
Τελικά κατάφερα και έφτιαξα ένα αρχείο (ίσως πρόγραμμα) όπου ανοίγω αρχεία XML και επιλέγω με vba αρχεία με εξωτερικά δεδομένα. Η ταχύτητα των υπολογισμών και το αποτέλεσμα, είναι πολύ γρήγορο. Μπορώ πλέον να δίδω αξιόπιστες απαντήσεις στα ερωτήματα που μου τίθενται.
Με λίγα λόγια για το αρχείο μου 1ον. Από την καρτέλα του προγραμματιστή έχω κάνει αντιστοίχιση των δεδομένων που ζητώ από το αρχείο XML και κάνω εισαγωγή 2ον Από λίστα επιλέγω το εξωτερικό αρχείο RF1 ... που ζητούν τα δεδομένα του XML με την χρήση του παραπάνω κώδικα και 3ον Οι συναρτήσεις INDEX, MATCH, VLOOKUP, OFFSET και INDIRECT ολοκληρώνουν το έργο.
Ευχαριστώ εσένα και το Forum, διότι διάβασα και έμαθα αρκετά.
Με χαρά και ενθουσιασμό προχωρώ στα επόμενα ...

kapetang 27-12-21 10:31

Να είσαι καλά και καλή συνέχεια με τον ίδιο ενθουσιασμό.


Η ώρα είναι 17:23.

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


Search Engine Optimization by vBSEO 3.3.2