Libre Office Calc ou Excel 2010 - Extraire couleur d'une cellule
Bonjour à tous
Je récupère des tableaux de données par le web.
Leur classement est codé par couleurs : magenta pour la 1ère, jaune pour la 2ème ...
Ce sont les couleurs de base : magenta, jaune, vert, bleu, cyan, rouge.
J'aimerai trouver une formule qui me donne les valeurs par leurs couleurs du genre, pour un résultat en E4 =si(couleur(E4)=magenta;1;"")
E4 : une cellule a analyser
Ligne : 1 entête des classements 1er, 2em, 3em ... de base
Résultat : Le magenta en E4 me dit que le 14 est en 1 (1ère position du classement final).
J'ai beaucoup cherché, même sur ce site mais je ne trouve pas.
Merci par avance de votre aide.
Lionel
Hello,
je ne sais pas si cela est faisable par formule mais en VBA cela n'est pas très compliqué :
Sub ChangeValueBasedOnCellColor()
Dim rg As Range
Dim xRg As Range
Set xRg = Selection.Cells
Application.DisplayAlerts = False
xRg.Copy
Range("B17").PasteSpecial xlPasteAll
For Each rg In Selection
With rg
Select Case .Interior.Color
Case Is = RGB(255, 0, 255) ' Magenta
.Value = 1
Case Is = RGB(255, 255, 0) ' Jaune
.Value = 2
Case Is = RGB(0, 255, 0) ' Vert
.Value = 3
Case Is = RGB(0, 255, 255) ' Cyan
.Value = 4
Case Is = RGB(255, 0, 0) ' Rouge
.Value = 5
Case Is = RGB(255, 255, 255) ' blanc
.Value = ""
End Select
End With
Next
Application.DisplayAlerts = False
End SubLe principe :
1- On sélectionne dans la feuille , la zone que l'on veut traiter
2- On lance la macro
3- La zone sélectionnée est recopiée en B17
4- On balaie toute la zone recopiée et on change la valeur des cellules suivant la couleur de fond des cellules.
Et pour du Basic LibreOffice en utilisant des plages fixes :
REM ***** BASIC *****
Sub ChangeValueBasedOnCellColor()
Dim oSheet As Object, source As Object, destination as Object
Dim selection As Object,x as Integer, y as Integer, v, c as Object
oSheet = thisComponent.Sheets.getByIndex(0)
selection = ThisComponent.CurrentSelection.getRangeAddress()
source = oSheet.getCellRangeByName("B1:M4").getRangeAddress()
destination = oSheet.getCellRangeByName("B17").getCellAddress()
oSheet.copyRange( destination , source )
for Each c in oSheet.getCellRangeByName("B18:M21").queryVisibleCells().getCells()
Select case c.CellBackColor
Case RGB(255, 0, 255): ' Magenta
c.Value = 1
Case RGB(255, 255, 0) ' Jaune
c.Value = 2
Case RGB(0, 255, 0) ' Vert
c.Value = 3
Case RGB(0, 255, 255) ' Cyan
c.Value = 4
Case RGB(255, 0, 0) ' Rouge
c.Value = 5
Case -1 ' blanc
c.String = ""
End Select
Next c
End SubEn pièces jointes les classeurs Excel et LibreOffice
Ami calmant, J.P
Voici la version avec sélection ( comme avec Excel) pour calc LibreOffice :
Sub ChangeValueBasedOnCellColor()
Dim oSheet As Object, source As Object, destination as Object, c as Object
oSheet = thisComponent.Sheets.getByIndex(0)
source = ThisComponent.CurrentSelection.getRangeAddress()
destination = oSheet.getCellRangeByName("B17").getCellAddress()
oSheet.copyRange( destination , source )
for Each c in oSheet.getCellRangeByPosition(destination.Column, _
destination.Row, _
destination.Column + source.EndColumn - source.StartColumn, _
destination.Row + source.EndRow - source.StartRow).queryVisibleCells().getCells()
Select case c.CellBackColor
Case RGB(255, 0, 255): ' Magenta
c.Value = 1
Case RGB(255, 255, 0) ' Jaune
c.Value = 2
Case RGB(0, 255, 0) ' Vert
c.Value = 3
Case RGB(0, 255, 255) ' Cyan
c.Value = 4
Case RGB(255, 0, 0) ' Rouge
c.Value = 5
Case -1 ' blanc
c.String = ""
End Select
Next c
End Sub
Bonjour,
Merci, j'ai trouvé une partie de ma réponse ... la "formule" dans EXCEL n'existe (apparemment) pas, donc il faut passer par une macro comme vous le proposez.
Je suis de la vieille école, mes macros sont en langage Excel 4 (je ne maitrise pas bien Visual Basic),
j'en ai récupéré une que j'ai adaptée, ça m'a pris 10 minutes et c'est nickel.
Avec cette macro, je fais une boucle pour parcourir toutes les cellules que je veux, passer à la ligne suivante et je donne le N° d'ordre voulu aux cases selon les couleurs.
C'est parfait !!
Je met une condition "fin" pour que ça s'arrête.
| Classement |
| =SI(LIRE.CELLULE(63;CELLULE.ACTIVE())=7; FORMULE(1)) |
| =SI(LIRE.CELLULE(63;CELLULE.ACTIVE())=6; FORMULE(2)) |
| =SI(LIRE.CELLULE(63;CELLULE.ACTIVE())=4; FORMULE(3)) |
| =SI(LIRE.CELLULE(63;CELLULE.ACTIVE())=5; FORMULE(4)) |
| =SELECTIONNER("LC(1)") |
| =SI(LIRE.CELLULE(63;CELLULE.ACTIVE())=7; FORMULE(1)) |
| =SI(LIRE.CELLULE(63;CELLULE.ACTIVE())=6; FORMULE(2)) |
| =SI(LIRE.CELLULE(63;CELLULE.ACTIVE())=4; FORMULE(3)) |
| =SI(LIRE.CELLULE(63;CELLULE.ACTIVE())=5; FORMULE(4)) |
| =SELECTIONNER("LC(1)") |
| =SI(LIRE.CELLULE(63;CELLULE.ACTIVE())=7; FORMULE(1)) |
| =SI(LIRE.CELLULE(63;CELLULE.ACTIVE())=6; FORMULE(2)) |
| =SI(LIRE.CELLULE(63;CELLULE.ACTIVE())=4; FORMULE(3)) |
| =SI(LIRE.CELLULE(63;CELLULE.ACTIVE())=5; FORMULE(4)) |
| …/… etc, etc selon le tableau d'origine |
| =SELECTIONNER("L(1)C(-7)") passage ligne suivante |
| =SI(CELLULE.ACTIVE()="Fin";ARRETER()) |
| =ATTEINDRE(Classement) boucle |
Merci pour votre aide et les macros.
Cordialement
Lionel