XL 2013 report de cellule quand je la rempli (couleur)

fred347

XLDnaute Nouveau
Bonjours a tous
Je suis nouveau sur le forum

Et j’ai besoin d’un peu d’aide
Mon classeur ce divise en 3 catégories
· Visuel
· Energie
· Capacité

Mon problème est celui-ci :
Je voudrais pouvoir faire du remplissage (couleur) de cellule dans :
· 2 énergies (colonne C)
· 3 énergies (colonne C)
· 4 énergies (colonne C
· Geme énergie (colonne D, G, J)
· 2 capacités (colonne E)
· 3 capacités (colonne E)
· 4 capacités (colonne E)
· Geme capacités (D, E, O)

Et que sa se retrouve dans la feuille « visuel »
Les chiffres que j’ai dans ma pages visuel sont les même que dans les autres classeurs sauf qu’elles sont triés

En gros je veux mètre des case rouge sur mes chiffres (énergie et capacité) et que sa je le vois dans mon visuel

ci je met sur 2energie mon 4.5 (c7) en rouge
upload_2016-7-22_12-13-9.png


je voudrai que dans visuel il soit rouge aussi
upload_2016-7-22_12-14-54.png

merci a tous d’avance
 

Pièces jointes

  • diggy.xlsx
    3.1 MB · Affichages: 87

job75

XLDnaute Barbatruc
Re,

Bon je suis parvenu à faire les rangements des valeurs dans la feuille "visuel".

Cela devient assez trapu, j'utilise la macro Quick sort pour le tri :
Code:
Private Sub Worksheet_Activate()
Dim i As Byte, a(), n&, ii As Byte, Source As Range, j&, b(), col As Byte, x, k&, Dest As Range, d As Object
Application.ScreenUpdating = False
Range("A4:M" & Rows.Count).Delete xlUp 'RAZ
'---RANGEMENTS---
For i = 1 To 7 Step 6 '2 tableaux de 6 colonnes
  Erase a
  n = 0
  '---liste de toutes les valeurs---
  For ii = i To i + 5
    Set Source = Evaluate(ThisWorkbook.Names("Source" & ii).RefersTo)
    Set Source = Intersect(Source, Source.Parent.UsedRange.EntireRow)
    For j = 1 To Source.Count
      If Source(j) <> "" Then
        n = n + 1
        ReDim Preserve a(1 To n)
        a(n) = Source(j)
      End If
  Next j, ii
  If n = 0 Then GoTo 1
  '---tri croissant et rangement des valeurs---
  tri a, 1, UBound(a)
  ReDim b(1 To n, 1 To 6)
  For ii = i To i + 5
    Set Source = Evaluate(ThisWorkbook.Names("Source" & ii).RefersTo)
    Set Source = Intersect(Source, Source.Parent.UsedRange.EntireRow)
    col = ii - i + 1
    For j = 1 To Source.Count
      x = Source(j)
      If x <> "" Then
        For k = 1 To n
          If x = a(k) And b(k, col) = "" Then b(k, col) = x: Exit For
        Next k
      End If
  Next j, ii
  Set Dest = Evaluate(ThisWorkbook.Names("Dest" & i).RefersTo)
  Dest(4).Resize(n, 6) = b
  '---suppression des lignes vides de chaque tableau---
  For j = n + 3 To 4 Step -1
    If Application.CountA(Dest(j).Resize(, 6)) = 0 Then Dest(j).Resize(, 6).Delete xlUp
1 Next j, i
'---COLORATIONS---
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To 12
  Set Source = Evaluate(ThisWorkbook.Names("Source" & i).RefersTo)
  Set Source = Intersect(Source, Source.Parent.UsedRange.EntireRow)
  Set Dest = Evaluate(ThisWorkbook.Names("Dest" & i).RefersTo)
  Set Dest = Intersect(Dest, Dest.Parent.UsedRange.EntireRow)
  d.RemoveAll
  n = 0
  For j = 4 To Dest.Count
    If Dest(j) <> "" Then n = n + 1: d(n) = j
  Next j
  n = 0
  For j = 1 To Source.Count
    If Source(j) <> "" Then
      n = n + 1
      If Dest(d(n)) <> Source(j) Then _
        MsgBox "La colonne 'Source" & i & "' n'est pas triée correctement !", 48: Exit For
      If Source(j).Interior.ColorIndex <> xlNone Then _
        Dest(d(n)).Interior.Color = Source(j).Interior.Color
    End If
Next j, i
End Sub

Sub tri(a, gauc, droi)     ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub
Il ne peut donc plus y avoir d'erreurs SAUF si les colonnes sources ne sont pas triées correctement.

Nouveau fichier joint.

A+
 

Pièces jointes

  • diggy avec rangement(1).xlsm
    3.1 MB · Affichages: 66
Dernière édition:

job75

XLDnaute Barbatruc
Re,

Pour terminer, ceci fonctionne même si les colonnes sources ne sont pas triées :
Code:
'---COLORATIONS---
For i = 1 To 12
  Set Source = Evaluate(ThisWorkbook.Names("Source" & i).RefersTo)
  Set Source = Intersect(Source, Source.Parent.UsedRange.EntireRow)
  Set Dest = Evaluate(ThisWorkbook.Names("Dest" & i).RefersTo)
  Set Dest = Intersect(Dest, Me.UsedRange.EntireRow)
  dc = Dest.Count
  For j = 1 To Source.Count
    x = Source(j)
    If x <> "" Then
      If Source(j).Interior.ColorIndex <> xlNone Then
        For k = 4 To dc
          If Dest(k) = x Then If Dest(k).Interior.ColorIndex = xlNone _
            Then Dest(k).Interior.Color = Source(j).Interior.Color: Exit For
        Next k
      End If
    End If
Next j, i
End Sub
Il n'y a plus d'objet Dictionary, cela prend plus de temps, mais aucune erreur n'est maintenant possible.

Fichier (2).

A+
 

Pièces jointes

  • diggy avec rangement(2).xlsm
    3.1 MB · Affichages: 79
Dernière édition:

fred347

XLDnaute Nouveau
Bonjour job75

Bravo pour tes solutions
Les questions que je me pose:
Comment sont saisie les données en feuille "Visuel" ?
A quoi cela sert, si la correspondance aux nombres n'est pas visuel ?
Salutations
JJ
bonjour
en fait la page visuel me sert juste a savoir quelle et le meilleur élément a installer (pour mon jeux )

1° dans mon jeux il y a des coche pour savoir ce que je peut acheter
upload_2016-7-25_20-2-13.png

2°c'est la que je transmet mes couleur sur ce que je peut prendre
upload_2016-7-25_20-5-28.png

3°je retourne sur la page "visuel" pour voir quelle est le meilleur a acheter
upload_2016-7-25_20-6-40.png

on vois quand mm mieux que sur des pages comme ca
surtout quand il y en a 43
upload_2016-7-25_20-8-16.png

merci a vous !!
 

Pièces jointes

  • upload_2016-7-25_20-3-54.png
    upload_2016-7-25_20-3-54.png
    72.1 KB · Affichages: 43

job75

XLDnaute Barbatruc
Bonjour,
Hello,
La dernière version retourne une erreur si on peinturlure la cellule C5 de "2 energie", c'est A7 sur la feuille "visuel" au lieu de A8
Ce n'est pas une erreur, sans le Dictionary on ne peut pas faire de différence entre les cellules de même valeur.

J'ai cependant corrigé le fichier (2) du post #19 avec For k = 4 To dc au lieu de k= 1

Je vais m'absenter pendant 10 jours.

A+
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof