Forum

Forum (https://www.ms-office.gr/forum/)
-   Excel - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/)
-   -   [VBA] Αλλαγή χρώματος κελιών υπό προϋποθέσεις με vb (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/936-allagi-xromatos-kelion-ypo-proipotheseis-me-visual-basic.html)

GEORGE1 24-01-11 13:52
Αλλαγή χρώματος κελιών υπό προϋποθέσεις με vb
 
Καλημέρα σε όλους,

Λοιπόν στο πρόβλημα … έχω ένα αρχείο με περίπου 22.000 – 25.000 γραμμές (μία με data & μία κενή και ενδιάμεσα και άλλες κενές όπως θα δείτε και στο συνημμένο) και τρείς στήλες στο Φύλλο1, αυτό γίνεται με copy paste από άλλο αρχείο που παράγει ένα πρόγραμμα εμπορικής διαχείρισης.
Με vb έχω την δυνατότητα τα κελιά στην στήλη C να χρωματίζονται ανάλογα με το υπόλοιπό τους . Το ζητούμενο είναι εκτός από το κελί της στήλης C να χρωματίζονται και τα διπλανά στις στήλες a & b κάποιες προσπάθειες που έκανα μου επέστεφαν χρωματισμό σε όλη την γραμμή … Σημειωτέον ότι το αρχείο που προκύπτει θα το δουλεύουν τόσο σε exel 2003 όσο και σε 2007 .
Υπάρχει κάποιος τρόπος ?

Ευχαριστώ,

Γιώργος

GEORGE1 24-01-11 13:56
1 Συνημμένο(α)
Και το ξεχασμένο αρχείο ... :thanks:

gr8styl 24-01-11 17:12
Φίλε Γιώργο
εγώ θα σου πρότεινα τον παρακάτω κώδικα
Κώδικας:
Private Sub CommandButton1_Click()
Dim Cell, Rng As Range
For Each Cell In Range("C1:C" & Range("C65536").End(xlUp).Row)
'επιλέγω τα κελιά της στήλης C
    If WorksheetFunction.IsNumber(Cell) Then
    'αν το κελί στην C είναι αριθμός
        Set Rng = Range("A" & Cell.Row & ":" & "C" & Cell.Row)
        'φτιάχνουμε το range που θα μορφοποιήσουμε. Στήλες A έως C
        Select Case Cell.Value
            Case Is < 0
            'όταν η τιμή στό κελί είναι μικρότερη από το 0 να γίνεται ΜΠΛΕ
                Rng.Interior.Color = vbBlue
            'με λευκούς χαρακτήρες
                Rng.Font.Color = vbWhite
            Case Is = 0
            'όταν η τιμή στό κελί είναι = 0 το χρώμα να αλλάζει σε ΚΟΚΚΙΝΟ
                Rng.Interior.Color = vbRed
            'με λευκούς χαρακτήρες
                Rng.Font.Color = vbWhite
            Case Is = 1
            'όταν η τιμή στό κελί είναι = 1 το χρώμα να αλλάζει σε ΚΙΤΡΙΝΟ
                Rng.Interior.Color = vbYellow
            Case Is > 1
            'όταν η τιμή στο κελί είναι > = 2 το χρώμα να αλλάζει σε ΠΡΑΣΙΝΟ
                Rng.Interior.Color = vbGreen
        End Select
    End If
Next Cell
Set Rng = Nothing
End Sub

GEORGE1 24-01-11 21:52
Θανάση καλησπέρα,

ok είναι τέλειο,σ΄ ευχαριστώ πάρα πολύ. :thanks: :thanks: :thanks:

______
PS
Με κάθε επιφύλαξη, μήπως είναι εύκολο όταν στην στήλη b υπάρχει η καταχώρηση: «Σύνολα Σελίδας», «Σε Μεταφορά», «Από Μεταφορά», «Γενικά Σύνολα» να μην γίνεται μορφοποίηση αλλά να παραμένουν λευκά τα κελιά ? αν είναι σχετικά εύκολο είναι ευπρόσδεκτο, αν παρουσιάζει δυσκολίες τότε το ξεχνάμε.
Και πάλι ένα μεγάλο ευχαριστώ. :thumbup1:

Φιλικά :047:

Γιώργος

gr8styl 24-01-11 23:28
Παράθεση:
Αρχική Δημοσίευση από GEORGE1 (Μήνυμα 5032)
... μήπως είναι εύκολο όταν στην στήλη b υπάρχει η καταχώρηση: «Σύνολα Σελίδας», «Σε Μεταφορά», «Από Μεταφορά», «Γενικά Σύνολα» να μην γίνεται μορφοποίηση αλλά να παραμένουν λευκά τα κελιά ?...
Γιώργο,
στον κώδικα που σου έδωσα, βάζεις ακριβώς πριν από την End Select την παρακάτω If (7 γραμμές) για κενό γέμισμα "xlNone" και αυτόματο χρώμα γραμματοσειράς "0".
Κώδικας:
    If Rng.Cells(1, 2) = "Σύνολα Σελίδας" Or _
      Rng.Cells(1, 2) = "Σε Μεταφορά" Or _
      Rng.Cells(1, 2) = "Από Μεταφορά" Or _
      Rng.Cells(1, 2) = "Γενικά Σύνολα" Then
                      Rng.Interior.ColorIndex = xlNone
                      Rng.Font.ColorIndex = 0
    End If
ΥΓ. Αν μας ανέβαζες ένα αρχείο όπως το βγάζει το πρόγραμμα εμπορικής διαχείρισης που λες, αν είναι txt ή csv ή xls υπάρχουν καλύτεροι τρόποι κάνοντας εισαγωγή δεδομένων αντί αντιγραφή επικόλληση.

GEORGE1 25-01-11 10:21
Παράθεση:
Αρχική Δημοσίευση από gr8styl (Μήνυμα 5033)
Γιώργο,
στον κώδικα που σου έδωσα, βάζεις ακριβώς πριν από την End Select την παρακάτω If (7 γραμμές) για κενό γέμισμα "xlNone" και αυτόματο χρώμα γραμματοσειράς "0".
Κώδικας:
    If Rng.Cells(1, 2) = "Σύνολα Σελίδας" Or _
      Rng.Cells(1, 2) = "Σε Μεταφορά" Or _
      Rng.Cells(1, 2) = "Από Μεταφορά" Or _
      Rng.Cells(1, 2) = "Γενικά Σύνολα" Then
                      Rng.Interior.ColorIndex = xlNone
                      Rng.Font.ColorIndex = 0
    End If
ΥΓ. Αν μας ανέβαζες ένα αρχείο όπως το βγάζει το πρόγραμμα εμπορικής διαχείρισης που λες, αν είναι txt ή csv ή xls υπάρχουν καλύτεροι τρόποι κάνοντας εισαγωγή δεδομένων αντί αντιγραφή επικόλληση.
Θανάση Καλημέρα,

και πάλι ένα ΜΕΓΑΛΟ ΕΥΧΑΡΙΣΤΩ :thanks:

Το αρχείο που ανέβασα είναι αυτό που έβγαλε η εμπορική διαχείριση απλά έχω σβήσει 22.000 γραμμές για να μην είναι τεράστιο ...

Φιλικά :047:

Γιώργος

kapetang 25-01-11 10:50
Καλημέρα
Φίλε Θανάση, επειδή η μορφοποίηση που δημιουργεί ο πρόσθετος κώδικάς σου δεν εξαρτάται από τις τιμές των κελιών της στήλης C, έχω τη γνώμη ότι θα πρέπει να είναι μετά τη δομή Select ...End Select και όχι μέσα σ’ αυτήν.
Φιλικά/Γιώργος

GEORGE1 25-01-11 11:06
Παράθεση:
Αρχική Δημοσίευση από kapetang (Μήνυμα 5036)
Καλημέρα
Φίλε Θανάση, επειδή η μορφοποίηση που δημιουργεί ο πρόσθετος κώδικάς σου δεν εξαρτάται από τις τιμές των κελιών της στήλης C, έχω τη γνώμη ότι θα πρέπει να είναι μετά τη δομή Select ...End Select και όχι μέσα σ’ αυτήν.
Φιλικά/Γιώργος
Καλημέρα συνονόματε,

Αν βοηθά : Όλα έχουν σαν κριτήριο την αναφερόμενη αξία στην στήλη C.
Ανάλογα με την αξία αυτή, γίνεται η αλλαγή Χρώματος κελιού και γραμματοσειράς.

Φιλικά

Γιώργος

kapetang 25-01-11 15:15
Καλησπέρα

Συνονόματε Γιώργο, αν κατάλαβα καλά, η μορφοποίηση των γραμμών με σύνολα («Σύνολα Σελίδας», «Σε Μεταφορά», «Από Μεταφορά», «Γενικά Σύνολα») η μορφοποίηση δεν εξαρτάται από την τιμή της στήλης C (<0, 0,1 >1), γι’ αυτό πιστεύω ότι ο σχετικός κώδικας πρέπει να είναι κάτω από τη δομή Select.
Πάντως, στο σύνολο σχεδόν των περιπτώσεων ο κώδικας του φίλου Θανάση δίνει σωστά αποτελέσματα (οπότε μπορείς να τον χρησιμοποιείς) και αν χρειαστεί κάποια τροποποίηση πιστεύω θα την κάνει ο ίδιος.

Φιλικά/Γιώργος

Tasos 25-01-11 15:40
1 Συνημμένο(α)
Καλησπέρα σε όλους!

Η Excel 2003 μας δίνει 3 μορφοποιήσεις υπό όρους + την στάνταρτ μορφοποίηση του κελιού δηλ. 4 στο σύνολο.
Στην περίπτωση του Γιώργου, μπορούμε να τις χρησιμοποιήσουμε και σε συνδυασμό με λίγο κώδικα VBA να φτάσουμε στο επιθυμητό αποτέλεσμα.

Μπορείτε να δείτε αυτή την προσέγγιση στο συνημμένο παράδειγμα παρακάτω.

Φιλικά

Τάσος

gr8styl 25-01-11 18:39
Καλησπέρα σας
Θα ήθελα να πω ότι πολύ σωστά παρατήρησε ο Γιώργος (kapetang), ότι η IF των 7 γραμμών πρέπει να μπει αμέσως ΜΕΤΑ την End Select για να είμαστε 100% σωστοί.
Αν και δεν νομίζω να υπάρξει περίπτωση να έχουμε γραμμές με "Σύνολα" ή "Μεταφορά" που η στήλη C να έχει τιμή μικρότερη ή ίση του 1 το σωστό είναι σωστό ευχαριστώ Γιώργο. :045:

Για την πρόταση του Τάσου να πω ότι μου φαίνεται ταχύτερη, και μας δείχνει και μερικά κόλπα χρησιμοποιώντας ονοματισμένες περιοχές με προκαθορισμένη μορφοποίηση. Ίσως όμως για κάποιον αρχάριο να είναι πιο δύσκολο να την κατανοήσει και να παρέμβει για να την αλλάξει. Τάσο, νομίζω ότι λείπει από τον κώδικα σου και η μορφοποίηση για πράσινο φόντο σαν στάνταρ μορφοποίηση των κελιών. Αν είχαμε 3 μόνο μορφοποιήσεις θα έλεγα είναι η ιδανική :cool:

Τα λέμε.
Θανάσης

Tasos 25-01-11 19:44
Καλησπέρα Θανάση!

Η μορφοποίηση για πράσινο φόντο είναι η στάνταρ μορφοποίηση των κελιών A1, B1, C1
και επικολλάται στις αντίστοιχες στήλες κατά την εκτέλεση της Μακροεντολής.

Αν χρειαστεί, με το τρόπο που επιλέγονται οι περιοχές του φύλλου από τον κώδικα,
θα είναι πολύ εύκολο να προσθέσει κανείς μια γραμμή στον κώδικα για να χρωματίσει ότι και
όπως θέλει!:wink:

Τα λέμε...

Φιλικά
Τάσος

gr8styl 25-01-11 21:41
Παράθεση:
Αρχική Δημοσίευση από Tasos (Μήνυμα 5045)
Η μορφοποίηση για πράσινο φόντο είναι η στάνταρ μορφοποίηση των κελιών A1, B1, C1
και επικολλάται στις αντίστοιχες στήλες κατά την εκτέλεση της Μακροεντολής.
Σωστά Τάσο
το λάθος είναι δικό μου, γιατί όταν δοκίμασα το αρχείο σου, αφαίρεσα το χρώμα φόντου σε ολόκληρες τις στήλες Α, Β και C, με αποτέλεσμα να μην μου δώσει πράσινες γραμμές.

Είναι πράγματι πολύ καλό. Δεν μου λες η περιοχή a1:c1 θα πρέπει να κατασκευάζεται κάθε φορά ?
Όπως είπε ο Γιώργος το αρχείο που ανέβασε είναι το output της εφαρμογής του.
Έχεις καμιά πρόταση για εισαγωγή των δεδομένων από το xls output της εφαρμογής του Γιώργου ?

Τα λέμε.
Θανάσης

GEORGE1 26-01-11 09:04
Καλημέρα,

Συνεχίζετε να με εκπλήσσετε ευχάριστα …

Ένα μεγάλο ευχαριστώ σε όλους …

Φιλικά

Γιώργος

Tasos 26-01-11 09:50
Καλημέρα Γιώργο μας!
Να είσαι καλά, σ ευχαριστούμε για τα καλά σου λόγια!
Ο Θανάσης αναφέρθηκε στο "output" της εφαρμογής σου.
Αλήθεια, πως μεταφέρονται τα δεδομένα στο εν λόγω φύλλο;
Στο παράδειγμα σου τουλάχιστον φαίνεται ότι είναι απλή επικόλληση (χειροκίνητα ή προγραμματιστικά).

Θανάση, η περιοχή a1:c1 φτιάχνεται μια φορά ή όποτε χρειαστούν αλλαγές στις μορφοποιήσεις από το χρήστη.
Θα μπορούσαμε να χτίσαμε τις μορφοποιήσεις αυτές προγραμματιστικά.
Ωστόσο, με τον τρόπο δεν θα παρέχεται πια η δυνατότητα στο χρήστη να κάνει τυχόν αλλαγές στις μορφοποιήσεις.
Συνήθως σε μεταφορά δεδομένων από κάποια εξωτερική πηγή χρησιμοποιείται ο OLDB Provider ή κάποια σύνδεση ODBC.

Τα λέμε...

Φιλικά/Τάσος


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

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


Search Engine Optimization by vBSEO 3.3.2