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

[sakis297]

Γεια σε όλους!!!
Θα ήθελα τη βοήθειά σας σε κάτι που νομίζω ότι είναι απλό.
Από μία ιστοσελίδα αντιγράφω κάποια δεδομένα - κελιά (σε μορφή στήλης) Τα κελιά αυτά δεν έχουν τιμές, αλλά έχουν χρώμα γεμίσματος κόκκινο, ή κίτρινο ή πράσινο.
Αυτό που θα ήθελα είναι το εξής: Όταν κάνω επικόλληση των δεδομένων σε φύλλο του Excel, ξεκινώντας από το Α1, να μπαίνει στο κελί η τιμή 1 αν το χρώμα γεμίσματος είναι κόκκινο, 2 αν είναι κίτρινο και 3 αν είναι πράσινο.
Φαντάζομαι ότι το πρόβλημα λύνεται με έναν απλό κώδικα σε vba, αλλά δυστυχώς οι γνώσεις μου είναι ελάχιστες σε vba.

[Spirosgr]

Η περιοχή που θα επικολλήσεις τα κελιά, έχει αρχή το a1
Οι γραμμές ή οι στήλες, είναι σταθερές ή μπορεί να αυξομειώνονται;

[sakis297]

Για την ακρίβεια είναι το E1.
Ο αριθμός των γραμμών δεν είναι σταθερός. Το μέγιστο είναι η γραμμή 1000.
Άρα τα δεδομένα μου μπορεί να εκτείνονται στην περιοχή E1:E1000.

[Spirosgr]

Καλημέρα
Έστω, η στήλη Ε, που έχει κελιά χρωματιστά.
Ο κώδικας:

Sub Macro1()
    Columns(5).Delete Shift:=xlToLeft
End Sub

διαγράφει όλη την στήλη ή
ο κώδικας:

Sub Macro2()
    With Columns(5).Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Columns(5).ClearContents
End Sub

καθαρίζει την στήλη.

Επέλεξε ένα εκ των δύο, που εξυπηρετεί καλύτερα.

Κάνεις paste στην Ε, τα κελιά, που έχεις αντιγράψει, από το δίκτυο.

Ο κώδικας (σύνδεσε ένα κουμπί):

Sub Macro3()
    Dim c As Range, rng As Range
    Set rng = Range("e1:e1000")
    Application.ScreenUpdating = False
    rng.ClearContents
    For Each c In rng
        Select Case c.Interior.Color
        Case vbRed
            c.Value = 1
        Case vbYellow
            c.Value = 2
        Case vbGreen
            c.Value = 3
        Case Else
            c.Value = vbNullString
        End Select
    Next
End Sub

υπολογίζει τις αξίες των κελιών, με βάση το χρώμα.

Σημειώσεις:
1
Δεν εξετάζονται, περεταίρω λεπτομέρειες, που αφορούν την δομή του φύλλου,
ή αυτοματισμοί, σε συμβάντα φύλλου.
2
Καθαρά χρώματα Office 2003

[sakis297]

Σπύρο, σ' ευχαριστώ πολύ για τη βοήθειά σου.
Το πράσινο και το χρυσό (άλλαξα το yellow κι έβαλα gold) δε δουλεύουν. Φαντάζομαι ότι πρέπει να βρούμε τις ακριβείς τιμές RGB των δύο χρωμάτων και να βάλουμε αυτές τις τιμές αντί του vbGreen, αλλά και πάλι δεν ξέρω πώς γίνεται.
Σου επισυνάπτω το αρχείο για να δεις τα ακριβή χρώματα.

[Spirosgr]

Όπως εξηγώ παραπάνω στις σημειώσεις:
«Καθαρά χρώματα Office 2003»

[sakis297]

Γεια σου Σπύρο!
Με την παρακάτω εντολή
MsgBox Selection.Interior.ColorIndex
κατάφερα να βρω ότι το κόκκινό μου αντιστοιχεί στο ColorIndex 3, το χρυσό στο 44 και το πράσινο στο 10.
Οπότε με τον παρακάτω κώδικα η δουλειά μου γίνεται μια χαρά.
Dim c As Range, rng As Range
Set rng = Range("e1:e1000")
Application.ScreenUpdating = False
rng.ClearContents
For Each c In rng

If c.Interior.ColorIndex = 10 Then
c.Value = 3
ElseIf c.Interior.ColorIndex = 44 Then
c.Value = 2
ElseIf c.Interior.ColorIndex = 3 Then
c.Value = 1
End If

Next

Η βοήθειά σου ήταν πολύτιμη. Σ' ευχαριστώ πολύ και πάλι!!!

[Spirosgr]

ωραία!
Γιατί άλλαξες με if την select case;

[sakis297]

Δεν υπήρχε λόγος να την αλλάξω.
Απλώς εκείνη την ώρα έκανα κάποιες δοκιμές με If και συνέχισα με If.