Forum

Forum (https://www.ms-office.gr/forum/)
-   Excel - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/)
-   -   [VBA] [EXCEL] Use Intersect with multi ranges and different Worksheets (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/6395-excel-use-intersect-multi-ranges-different-worksheets.html)

spmatrix 23-11-23 18:28

[EXCEL] Use Intersect with multi ranges and different Worksheets
 
1 Συνημμένο(α)
Καλησπέρα στην ομάδα.

Στο συνημμένο αρχείο, έχω προσπαθήσει να φτιάξω ένα κώδικα vba, το οποίο μέχρι στιγμής λειτουργεί.
Αυτό που θέλω να κάνω και δεν μπορώ γιατί είμαι αρχάριος, είναι το εξής.
Έχω τον κώδικα στο Workbook για να λειτουργεί σε όλα τα φύλλα. Εκεί έχω το intersect
Κώδικας:

If Not Intersect(Target, Range("C8:E2000")) Is Nothing Then
....
....
For Each cell In Intersect(Target, Range("C8:E2000"))

που του ορίζω συγκεκριμένα κελιά.

Το θέμα είναι ότι έχω βάλει τις ίδιες γραμμές σε όλα τα φύλλα, πράγμα που δεν χρειάζεται.
Δηλαδή το φύλλο "ΔΔ" μπορεί να έχει 2000 γραμμές, ενώ το φύλλο "000-Α" μπορεί να έχει μόνο 100 γραμμές. Το ίδιο ισχύει και για τα υπόλοιπα φύλλα (διαφορετικός αριθμός γραμμών).
Στην πραγματικότητα όλα έχουν 2000 και έτσι μεγαλώνει και ο όγκος του αρχείου.

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

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

Να σημειώσω ότι υπάρχει και 2ος κώδικας σε κάθε φύλλο και οι γραμμές που αναφέρονται στον κώδικα, έχουν διαγραφή για να μπορέσει να μειωθεί ο όγκος του αρχείου.


Σας ευχαριστώ εκ των προτέρων.

Με εκτίμηση/σεβασμό
Σπύρος

ChrisGT7 23-11-23 19:17

Καλησπέρα Σπύρο,

Δοκίμασε να αντικαταστήσεις το Range("C8:E2000") με το Range("C8:E" & Range("A" & Rows.Count).End(xlUp).Row).

Στα υπόλοιπα φύλλα δοκίμασε επίσης να αντικαταστήσεις το Range("E8:E2000") με το Range("E8:E" & Range("A" & Rows.Count).End(xlUp).Row).

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

spmatrix 25-11-23 12:41

Παράθεση:

Αρχική Δημοσίευση από ChrisGT7 (Μήνυμα 35130)
Καλησπέρα Σπύρο,

Δοκίμασε να αντικαταστήσεις το Range("C8:E2000") με το Range("C8:E" & Range("A" & Rows.Count).End(xlUp).Row).

Στα υπόλοιπα φύλλα δοκίμασε επίσης να αντικαταστήσεις το Range("E8:E2000") με το Range("E8:E" & Range("A" & Rows.Count).End(xlUp).Row).

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

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

ChrisGT7 25-11-23 13:01

Καλησπέρα Σπύρο,

Τον είχα δει τον κώδικα του αρχείο, γι' αυτό αναφέρω αυτή την αλλαγή.

Το συμβάν Workbook_SheetChange ενεργοποιείται όταν γίνεται κάποια αλλαγή σε οποιοδήποτε φύλλο εργασίας του βιβλίου. Δεν εκτελείται όμως ταυτόχρονα σε όλα τα φύλλα αλλά μονάχα σ' εκείνο που έγινε η αλλαγή. Επομένως, άλλη γραμμή θα έχει το Range("A" & Rows.Count).End(xlUp).Row αν εκτελεστεί στο φύλλο π.χ. 200Α και άλλη στο 700Α αν έχουν προφανώς διαφορετικό πλήθος γραμμών.

Επίσης, θα μπορούσες να δημιουργήσεις ένα module με μια δημόσια διαδικασία π.χ. EGINAN_ALLAGES και να συμπεριλάβεις τις εντολές του Worksheet_Change που υπάρχουν σε όλα τα φύλλα, έτσι ώστε να έχεις λίγο μικρότερο μέγεθος αρχείου. Απλά μετά στο Worksheet_Change θα καλείς μόνο την EGINAN_ALLAGES().

spmatrix 25-11-23 16:46

Ναι συγνώμη, εγώ δεν το κατάλαβα.

Ωραία μέχρι εδώ, αλλά τι γίνεται με τα 100B ....?

Μπορώ να βάλω και δεύτερο "&" συνεχόμενα ?

Edit:
Πιστεύω ότι το κατάφερα (βέβαια με την πολύτιμη βοήθεια σου), αντικατέστησα το Range("A" & Rows.Count) με το Range("A" & "B" & Rows.Count) για να μπορεί να δουλεύει και στα άλλα φύλλα (ελπίζω να είναι σωστό. Όσο για το φύλλο "ΔΔ", του πρόσθεσα ένα "Α" στο τέλος για να μπορεί και αυτό να λειτουργεί.

ChrisGT7 25-11-23 18:39

1 Συνημμένο(α)
Σπύρο,

Κάνε δοκιμές στο συνημμένο αρχείο να δεις αν σε βολεύει καλύτερα.

Όπως θα δεις, συρρίκνωσα λίγο τον κώδικα του Workbook_SheetChange() και έκανα ένα module με τη διαδικασία EGINAN_ALLAGES() για τα υπόλοιπα φύλλα εργασίας.

Στο Workbook_SheetChange() πρόσθεσα τη γραμμή If Len(Sh.Name) > 4 Then Exit Sub έτσι ώστε ο κώδικας να εκτελείται μονάχα στα φύλλα εργασίας που το πλήθος γραμμάτων του ονόματός τους (π.χ. 000Α) είναι μικρότερο των 4 χαρακτήρων.

Ίσως αυτό να εννοούσες πριν όταν είπες πως επηρεάζει όλα τα φύλλα. Λογικά ο κώδικας δεν πρέπει να εκτελεστεί στο φύλλο π.χ. ΜΕΝΟΥ ή Όροι Χρήσης, αν καταλαβαίνω καλά. Οπότε αν κρατάς το μέγεθος αυτών των φύλλων κάτω από 4 χαρακτήρες, δεν θα έχεις πρόβληβα. Αλλιώς, θα πρέπει να γίνει μια λίστα με τα ονόματα των φύλλων που δεν πρέπει να εκτελείται.

Για οποιαδήποτε άλλη απορία, με ενημερώνεις αν μπορώ να βοηθήσω περισσότερο.

spmatrix 25-11-23 19:54

Πωωω, σ' ευχαριστώ πάρα πολύ. Όπως έχω αναφέρει είμαι αρχάριος. Αυτό που έκανες με το module και την συρίκνωση του κώδικα, δεν υπήρχε περίπτωση να το καταφέρω.

Και πάλι σ' ευχαριστώ πολύ. Είσαι και ο πρώτος :icon_n1: !!

Υπάρχει βέβαια κάτι ακόμα, αλλά και πάλι δεν χρειάζεται να ασχοληθείς αν δεν θέλεις ή δεν έχεις άλλο χρόνο.

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

ChrisGT7 25-11-23 20:10

Αν εννοείς το αντίστοιχο κελί στη στήλη Ζ γίνει 10, τότε δοκίμασε τα εξής:

Στον κώδικα που έχω την ισότητα C = 24, πρόσθεσε ακριβώς από κάτω την εξής γραμμή:
Κώδικας:

Range("C" & R & ":E" & R).Locked = True
Ελπίζω να είναι αυτό που ζητάς.

spmatrix 25-11-23 20:45

Είσαι θεός.

Thank you.


Η ώρα είναι 04:09.

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


Search Engine Optimization by vBSEO 3.3.2