Forum
Σελίδα 1 από 2 1 2
Εμφάνιση 40 μηνυμάτων αυτού του θέματος σε μία σελίδα

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 να φτάσουμε στο επιθυμητό αποτέλεσμα.

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

Φιλικά

Τάσος


Η ώρα είναι 04:31.
Σελίδα 1 από 2 1 2
Εμφάνιση 40 μηνυμάτων αυτού του θέματος σε μία σελίδα

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


Search Engine Optimization by vBSEO 3.3.2