[VBA] Αλλαγή χρώματος κελιού ανάλογα με την τιμή του κελιού

[kapetang]

Καλησπέρα

Βασίλη, δοκίμασε τον κώδικα:

'GEMISMA XROMATOS
    lRow = Sheets("ΑΡΧΕΙΟ").Range("F" & Rows.Count).End(xlUp).Row
    Set MR = Sheets("ΑΡΧΕΙΟ").Range("F2:F" & lRow)
    
    For Each cell In MR
        Select Case cell
        Case Is <= 4
            cell.Interior.ColorIndex = 45
        Case Is <= 7
            cell.Interior.ColorIndex = 4
        Case Is < 10
            cell.Interior.ColorIndex = 14
        Case Else
            cell.Interior.ColorIndex = 3
        End Select
    Next

Αντί για κώδικα θα μπορούσες να χρησιμοποιήσεις μορφοποίηση υπό όρους.

[bilakos26]

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

Καλησπέρα

Βασίλη, δοκίμασε τον κώδικα:

'GEMISMA XROMATOS
    lRow = Sheets("ΑΡΧΕΙΟ").Range("F" & Rows.Count).End(xlUp).Row
    Set MR = Sheets("ΑΡΧΕΙΟ").Range("F2:F" & lRow)
    
    For Each cell In MR
        Select Case cell
        Case Is <= 4
            cell.Interior.ColorIndex = 45
        Case Is <= 7
            cell.Interior.ColorIndex = 4
        Case Is < 10
            cell.Interior.ColorIndex = 14
        Case Else
            cell.Interior.ColorIndex = 3
        End Select
    Next

Αντί για κώδικα θα μπορούσες να χρησιμοποιήσεις μορφοποίηση υπό όρους.

Θα μπορούσε η αλλαγή χρώματος να γίνει την στιγμή που γίνεται η μετακίνηση στο κελί;; αντί να κάθεται και να ψάχνει όλα τα κελιά της σειράς; εννοώ να μπει στο σημείο του κώδικα 'METAKINHSH SE ARXEIO

[kapetang]

Πρόσθεσε μετά τη μετακίνηση και πριν από το άδειασμα τον κώδικα:

    Set cell = Worksheets("ΑΡΧΕΙΟ").Cells(l + j - 9, 6).Offset(-1)
    Select Case cell
    Case Is <= 4
        cell.Interior.ColorIndex = 45
    Case Is <= 7
        cell.Interior.ColorIndex = 4
    Case Is < 10
        cell.Interior.ColorIndex = 14
    Case Else
        cell.Interior.ColorIndex = 3
    End Select

[bilakos26]

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

Πρόσθεσε μετά τη μετακίνηση και πριν από το άδειασμα τον κώδικα:

    Set cell = Worksheets("ΑΡΧΕΙΟ").Cells(l + j - 9, 6).Offset(-1)
    Select Case cell
    Case Is <= 4
        cell.Interior.ColorIndex = 45
    Case Is <= 7
        cell.Interior.ColorIndex = 4
    Case Is < 10
        cell.Interior.ColorIndex = 14
    Case Else
        cell.Interior.ColorIndex = 3
    End Select

Ο κώδικας αυτός έκανε ακριβώς αυτό που ήθελα!
Είσαι φανταστικός!! Σε ευχαριστώ πολύ :D