Forum

Forum (https://www.ms-office.gr/forum/)
-   Excel - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/)
-   -   [VBA] COPY IF (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/2979-copy-if.html)

othonas 02-02-14 12:27

COPY IF
 
Καλημέρα σε όλους . Έστω ότι σε πολλά φύλλα (τα οποία είναι ονόματα υπαλλήλων ) υπάρχουν στο κελί Α1 το όνομα και Β1:Β10 διάφορα ποσά . θα ήθελα να αντιγράψω με VBA σε ένα νέο φύλλο από κάθε φύλλο τα εξής : εάν στην Β τα ποσά είναι μεγαλύτερα του μηδέν τότε στη στήλη Α τα ονόματα και στην Β τα ποσά , αλλιώς να μην αντιγράφει τίποτα . π.χ.
εάν στο φύλλο ΓΙΑΝΝΗΣ
το Β2 είναι 10,00
το Β3 είναι 0
το Β4 είναι 5,00
και στο φύλλο ΝΙΚΟΣ
το Β2 είναι 0,00
το Β3 είναι 50,00
το Β4 είναι 25,00
τότε στο φύλλο ΜΗΝΑΣ
α) στο κελί Α1 να μεταφέρει το Β2 του ΓΙΑΝΝΗ και όχι του ΝΙΚΟΥ το Β2 που είναι μηδέν ,
β) στο κελί Β1 να μεταφέρει το Β3 του ΝΙΚΟΥ και όχι το Β3 του ΓΙΑΝΝΗ που είναι μηδέν ,
γ) στο κελί c1 να μεταφέρει το Β4 του ΓΙΑΝΝΗ και στο c2 το Β4 του ΝΙΚΟΥ .

Spirosgr 02-02-14 18:21

'Οθωνα
Η συνθήκη copy if είναι σαφέστατη
ότι δεν είναι μηδενικό αντιγράφεται
Αλλά νομίζω πρέπει να διευκρινιστεί και το paste where
δηλαδή που το επικολλά και με τι κριτήριο
παράδειγμα
α) στο κελί Α1 να μεταφέρει το Β2 του ΓΙΑΝΝΗ και όχι του ΝΙΚΟΥ το Β2 που είναι μηδέν ,
Αν είναι και τα δύο μηδέν ?
β) στο κελί Β1 να μεταφέρει το Β3 του ΝΙΚΟΥ και όχι το Β3 του ΓΙΑΝΝΗ που είναι μηδέν ,
θα πάρει από εδώ και θα το βάλει σε ότι βρει κενό χύμα...?
ή πρέπει να επιλέξει στήλη ανάλογα με τις εγγραφές του φύλλου ΜΗΝΑΣ
Ανέβασε κάποιο παράδειγμα όπως είναι το "καλό" σου βιβλίο

othonas 03-02-14 09:44

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

Tasos 03-02-14 10:11

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

Ευχαριστώ.

Με εκτίμηση
Τάσος

othonas 03-02-14 10:49

Ορθα Τασο εχεις δικιο και συγνωμη.
Εστω οτι εχουμε χ φυλλα απο τα οποια θα αντιγραψουμε τα κελια B12:f12 εαν ομως το κελι Β12>0.
ετσι :

If Sheets(x).Range("B12") > 0 Then
ActiveWorkbook.Sheets(x).Range("C2").Copy
Worksheets("Φύλλο1").Range("A" & x).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveWorkbook.Sheets(x).Range("B12:f12").Copy
Worksheets("Φύλλο1").Range("B" & x).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If

Spirosgr 03-02-14 13:06

Καλησπέρα
Για τους φίλους που παρακολουθούν το θέμα αυτό να πω το εξής:
Ο κώδικας που προτείνεται δεν αντιστοιχεί 100% στο αρχικό ζητούμενο
Για να δουλέψει όμως ακόμα και σε αυτήν την μορφή πρέπει:
1. να οριστεί ο x ως μεταβλητή ακέραιος ... Dim x as Integer
2. να ορίσουμε τα όρια του x από - έως ... For x = 1 to Sheets.Count
3. πριν την ολοκλήρωση (End sub) να μπει ένα Next x
και βέβαια πιθανόν με το όλο στήσιμο το οποίο
δεν γνωρίζουμε να χρειάζονται κάποιοι έλεγχοι...

Tasos 03-02-14 13:52

Γεια σας!

Όθωνα, Σπύρο σας ευχαριστώ για τη συμμετοχή σας!

Πάμε για άλλα!

Τάσος


Η ώρα είναι 05:46.

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


Search Engine Optimization by vBSEO 3.3.2