Ανανέωση ιστοσελίδας
ms-office.gr > Forum > Microsoft Excel > Excel - Ερωτήσεις / Απαντήσεις > [VBA] [EXCEL] Use Intersect with multi ranges and different Worksheets

Excel - Ερωτήσεις / Απαντήσεις Ότι έχει σχέση με συναρτήσεις, μορφοποίηση, εκτυπώσεις γραφήματα κτλ.

Απάντηση στο θέμα

 

Εργαλεία Θεμάτων Τρόποι εμφάνισης
  #1  
Παλιά 23-11-23, 19:28
Όνομα: Σπύρος
Έκδοση λογισμικού Office: Ms-Office 2010, Ms-Office 365
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 21-02-2023
Μηνύματα: 14
Προεπιλογή [EXCEL] Use Intersect with multi ranges and different Worksheets

Καλησπέρα στην ομάδα.

Στο συνημμένο αρχείο, έχω προσπαθήσει να φτιάξω ένα κώδικα 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ος κώδικας σε κάθε φύλλο και οι γραμμές που αναφέρονται στον κώδικα, έχουν διαγραφή για να μπορέσει να μειωθεί ο όγκος του αρχείου.


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

Με εκτίμηση/σεβασμό
Σπύρος
Συνημμένα Αρχεία
Τύπος Αρχείου: xlsm ΠΡΩΤΥΠΟ ΠΡΩΤΟΚΟΛΛΟ ΓΡΑΜΜΑΤΕΙΑΣ 202Χ ver. 2.22 ΜΕ VBA - Αντι?.xlsm (351,6 KB, 11 εμφανίσεις)
Απάντηση με παράθεση
  #2  
Παλιά 23-11-23, 20:17
Το avatar του χρήστη ChrisGT7
Διαχειριστής
Όνομα: Χρήστος Ζώρζος
Έκδοση λογισμικού Office: Ms-Office 2016
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 20-09-2013
Περιοχή: Κοντά σε ηφαίστειο...
Μηνύματα: 972
Προεπιλογή

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

Δοκίμασε να αντικαταστήσεις το 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).

Θεωρώ πως στη στήλη Α των φύλλων θα υπάρχει πάντα ο ίδιος τύπος για τον υπολογισμό του Α/Α έτσι ώστε ο παραπάνω τύπος που προτείνω να φέρνει πάντα την τελευταία γραμμή του πίνακα εργασίας κάθε φύλλου.
__________________
Your Curiosity Will Be The Death Of You!
Απάντηση με παράθεση
  #3  
Παλιά 25-11-23, 13:41
Όνομα: Σπύρος
Έκδοση λογισμικού Office: Ms-Office 2010, Ms-Office 365
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 21-02-2023
Μηνύματα: 14
Προεπιλογή

Παράθεση:
Αρχική Δημοσίευση από ChrisGT7 Εμφάνιση μηνυμάτων
Καλησπέρα Σπύρο,

Δοκίμασε να αντικαταστήσεις το 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 και θα καταλάβεις.
Απάντηση με παράθεση
  #4  
Παλιά 25-11-23, 14:01
Το avatar του χρήστη ChrisGT7
Διαχειριστής
Όνομα: Χρήστος Ζώρζος
Έκδοση λογισμικού Office: Ms-Office 2016
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 20-09-2013
Περιοχή: Κοντά σε ηφαίστειο...
Μηνύματα: 972
Προεπιλογή

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

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

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

Επίσης, θα μπορούσες να δημιουργήσεις ένα module με μια δημόσια διαδικασία π.χ. EGINAN_ALLAGES και να συμπεριλάβεις τις εντολές του Worksheet_Change που υπάρχουν σε όλα τα φύλλα, έτσι ώστε να έχεις λίγο μικρότερο μέγεθος αρχείου. Απλά μετά στο Worksheet_Change θα καλείς μόνο την EGINAN_ALLAGES().
__________________
Your Curiosity Will Be The Death Of You!
Απάντηση με παράθεση
  #5  
Παλιά 25-11-23, 17:46
Όνομα: Σπύρος
Έκδοση λογισμικού Office: Ms-Office 2010, Ms-Office 365
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 21-02-2023
Μηνύματα: 14
Προεπιλογή

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

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

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

Edit:
Πιστεύω ότι το κατάφερα (βέβαια με την πολύτιμη βοήθεια σου), αντικατέστησα το Range("A" & Rows.Count) με το Range("A" & "B" & Rows.Count) για να μπορεί να δουλεύει και στα άλλα φύλλα (ελπίζω να είναι σωστό. Όσο για το φύλλο "ΔΔ", του πρόσθεσα ένα "Α" στο τέλος για να μπορεί και αυτό να λειτουργεί.
Απάντηση με παράθεση
  #6  
Παλιά 25-11-23, 19:39
Το avatar του χρήστη ChrisGT7
Διαχειριστής
Όνομα: Χρήστος Ζώρζος
Έκδοση λογισμικού Office: Ms-Office 2016
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 20-09-2013
Περιοχή: Κοντά σε ηφαίστειο...
Μηνύματα: 972
Προεπιλογή

Σπύρο,

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

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

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

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

Για οποιαδήποτε άλλη απορία, με ενημερώνεις αν μπορώ να βοηθήσω περισσότερο.
Συνημμένα Αρχεία
Τύπος Αρχείου: xlsm ΠΡΩΤΥΠΟ ΠΡΩΤΟΚΟΛΛΟ ΓΡΑΜΜΑΤΕΙΑΣ 202Χ (ver. 2.30).xlsm (334,0 KB, 12 εμφανίσεις)
__________________
Your Curiosity Will Be The Death Of You!
Απάντηση με παράθεση
  #7  
Παλιά 25-11-23, 20:54
Όνομα: Σπύρος
Έκδοση λογισμικού Office: Ms-Office 2010, Ms-Office 365
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 21-02-2023
Μηνύματα: 14
Προεπιλογή

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

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

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

Μόλις γίνει και η τελευταία αλλαγή, η δέκατη φορά, να κάνει τα κελιά c,d,e στη γραμμή αυτή ξανά προστατευμένα, έτσι ώστε να μην μπορεί να γίνει περαιτέρω αλλαγή.
Απάντηση με παράθεση
  #8  
Παλιά 25-11-23, 21:10
Το avatar του χρήστη ChrisGT7
Διαχειριστής
Όνομα: Χρήστος Ζώρζος
Έκδοση λογισμικού Office: Ms-Office 2016
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 20-09-2013
Περιοχή: Κοντά σε ηφαίστειο...
Μηνύματα: 972
Προεπιλογή

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

Στον κώδικα που έχω την ισότητα C = 24, πρόσθεσε ακριβώς από κάτω την εξής γραμμή:
Κώδικας:
Range("C" & R & ":E" & R).Locked = True
Ελπίζω να είναι αυτό που ζητάς.
__________________
Your Curiosity Will Be The Death Of You!
Απάντηση με παράθεση
  #9  
Παλιά 25-11-23, 21:45
Όνομα: Σπύρος
Έκδοση λογισμικού Office: Ms-Office 2010, Ms-Office 365
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 21-02-2023
Μηνύματα: 14
Προεπιλογή

Είσαι θεός.

Thank you.
Απάντηση με παράθεση
Απάντηση στο θέμα


Δικαιώματα - Επιλογές
Δε μπορείτε να δημοσιεύσετε νέα μηνύματα
Δε μπορείτε να δημοσιεύσετε απαντήσεις
Δεν μπορείτε να επισυνάψετε αρχεία
Δεν μπορείτε να επεξεργαστείτε τα μηνύματα σας

Ο κώδικας ΒΒ είναι σε λειτουργία
Τα Smilies είναι σε λειτουργία
Ο κώδικας [IMG] είναι σε λειτουργία
Ο κώδικας HTML είναι εκτός λειτουργίας
Trackbacks are εκτός λειτουργίας
Pingbacks are εκτός λειτουργίας
Refbacks are εκτός λειτουργίας


Παρόμοια Θέματα

Θέμα Δημιουργός Forum Απαντήσεις Τελευταίο Μήνυμα
[VBA] multi labels forColor gfevran Excel - Ερωτήσεις / Απαντήσεις 2 01-06-20 17:22


Η ώρα είναι 08:32.