[VBA] Αλλαγή χρώματος κελιών υπό προϋποθέσεις με vb

[GEORGE1]

Καλημέρα σε όλους,

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

Ευχαριστώ,

Γιώργος

[GEORGE1]

Και το ξεχασμένο αρχείο ...

[gr8styl]

Φίλε Γιώργο
εγώ θα σου πρότεινα τον παρακάτω κώδικα

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]

Θανάση καλησπέρα,

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

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

Φιλικά

Γιώργος

[gr8styl]

Αρχική Δημοσίευση από GEORGE1

... μήπως είναι εύκολο όταν στην στήλη 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]

Αρχική Δημοσίευση από gr8styl

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

Θανάση Καλημέρα,

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

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

Φιλικά

Γιώργος

[kapetang]

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

[GEORGE1]

Αρχική Δημοσίευση από kapetang

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

Καλημέρα συνονόματε,

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

Φιλικά

Γιώργος

[kapetang]

Καλησπέρα

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

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

[Tasos]

Καλησπέρα σε όλους!

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

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

Φιλικά

Τάσος