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

Jacky67

XLDnaute Barbatruc
pas de réponse ??
Bonjour,
Un début de réponse par VBA pour les parties "energie " et "capacité"
J'ai renommé la feuille "4 énergie" en "4 energie"
Comme il y a des doublons et pas de comparaison possible, ce sera la première donnée du même nombre qui sera prise en compte. Je ne suis pas certain que cela soit le résultat souhaité.:(
Pour le reste, si on peut déplacer les données de la feuille · Geme capacités (D, E, O)
en · Geme capacités (colonne D, G, J), ....peut-être :rolleyes:
Salutations
JJ
 

Pièces jointes

  • diggy.xlsm
    3.1 MB · Affichages: 72
Dernière édition:

fred347

XLDnaute Nouveau
bonjour,
un grand merci a toi jacky67
c'est tout a fait ce qu'il me fallait
oui il est possible de déplacer les 3 colonnes geme capacite ( même ci je n'ai pas compris ou tu voulez les mettre lol).
mais juste une petite question supplémentairement , comment a tu fait a t'il un tuto pour faire ce genre de (calcul)
 

job75

XLDnaute Barbatruc
Bonjour fred347, Jaccky67,

Dans cette affaire la vraie difficulté a été de copier les valeurs dans la feuille "visuel" (les trier comme vous dites).

Comment feriez-vous s'il y en a des milliers, voire des dizaines de milliers ???

Une fois que cela est fait correctement copier les couleurs n'est pas trop difficile.

Il faut commencer par nommer les colonnes sources (Source1 à Source12) et les colonnes des destination (Dest1 à Dest12).

Ensuite placer cette macro dans le code de la feuille "visuel" :
Code:
Private Sub Worksheet_Activate()
Dim i As Byte, Source As Range, Dest As Range, n&, c As Range, p&, j&
Application.ScreenUpdating = False
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)
  If Dest.Count > 3 Then Dest(4).Resize(Dest.Count - 3).Interior.ColorIndex = xlNone 'RAZ
  n = 0
  For Each c In Source
  If c <> "" Then
  n = n + 1
  If c.Interior.ColorIndex <> xlNone Then
  p = 0
  For j = 4 To Dest.Count
  If Dest(j) <> "" Then
  p = p + 1
  If p = n Then Dest(j).Interior.Color = c.Interior.Color: Exit For
  End If
  Next
  End If
  End If
Next c, i
End Sub
La macro s'exécute quand on active la feuille.

Fichier joint.

A+
 

Pièces jointes

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

fred347

XLDnaute Nouveau
Bonjour fred347, Jaccky67,

Dans cette affaire la vraie difficulté a été de copier les valeurs dans la feuille "visuel" (les trier comme vous dites).

Comment feriez-vous s'il y en a des milliers, voire des dizaines de milliers ???

Une fois que cela est fait correctement copier les couleurs n'est pas trop difficile.

Il faut commencer par nommer les colonnes sources (Source1 à Source12) et les colonnes des destination (Dest1 à Dest12).

Ensuite placer cette macro dans le code de la feuille "visuel" :
Code:
Private Sub Worksheet_Activate()
Dim i As Byte, Source As Range, Dest As Range, n&, c As Range, p&, j&
Application.ScreenUpdating = False
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)
  If Dest.Count > 3 Then Dest(4).Resize(Dest.Count - 3).Interior.ColorIndex = xlNone 'RAZ
  n = 0
  For Each c In Source
  If c <> "" Then
  n = n + 1
  If c.Interior.ColorIndex <> xlNone Then
  p = 0
  For j = 4 To Dest.Count
  If Dest(j) <> "" Then
  p = p + 1
  If p = n Then Dest(j).Interior.Color = c.Interior.Color: Exit For
  End If
  Next
  End If
  End If
Next c, i
End Sub
La macro s'exécute quand on active la feuille.

Fichier joint.

A+
je suis dsl je ne comprend pas "activé"la feuille visuel??
 

job75

XLDnaute Barbatruc
Re,
je suis dsl je ne comprend pas "activé"la feuille visuel??
Clic sur l'onglet :rolleyes:
n'est t'il pas possible de faire un "si alors sinon" si le premier est fait, passer a l'autre?
Ma macro du post #7 règle le problème des doublons.

Notez aussi que les couleurs des colonnes de destination sont effacées (RAZ) avant d'être colorées.

A+
 

job75

XLDnaute Barbatruc
Re,

La macro est à placer dans le code de la feuille "visuel" (clic droit sur l'onglet et Visualiser le code).

Ensuite clic sur l'onglet, la macro se déclenche automatiquement.

Voici maintenant une solution meilleure car plus rapide avec l'objet Dictionary :
Code:
Private Sub Worksheet_Activate()
Dim d As Object, i As Byte, Source As Range, Dest As Range, n&, j&
Set d = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
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)
  If Dest.Count > 3 Then Dest(4).Resize(Dest.Count - 3).Interior.ColorIndex = xlNone 'RAZ
  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 Source(j).Interior.ColorIndex <> xlNone Then _
  If d.exists(n) Then Dest(d(n)).Interior.Color = Source(j).Interior.Color
  End If
Next j, i
End Sub
Edit : je n'utilise plus la variable c (Range), la macro est plus homogène.

Fichier (2).

Bonne soirée.
 

Pièces jointes

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

job75

XLDnaute Barbatruc
Bonjour fred347, le forum,

Il y a plusieurs erreurs dans les colonnes de destination, cette macro les met en évidence :
Code:
Private Sub Worksheet_Activate()
Dim d As Object, i As Byte, Source As Range, Dest As Range, n&, j&, dc&
Set d = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
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)
  If Dest.Count > 3 Then Dest(4).Resize(Dest.Count - 3).Interior.ColorIndex = xlNone 'RAZ
  d.RemoveAll
  n = 0
  For j = 4 To Dest.Count
  If Dest(j) <> "" Then n = n + 1: d(n) = j
  Next j
  dc = d.Count
  n = 0
  For j = 1 To Source.Count
  If Source(j) <> "" Then
  n = n + 1
  If n > dc Then MsgBox "Nombre de valeurs insuffisant en 'Dest" & i & "' !", 48: GoTo 1
  If Dest(d(n)) <> Source(j) Then _
  MsgBox "Valeur incorrecte en " & Dest(d(n)).Address(0, 0) & " !", 48: GoTo 1
  If Source(j).Interior.ColorIndex <> xlNone Then _
  Dest(d(n)).Interior.Color = Source(j).Interior.Color
  End If
  Next j
  If n < dc Then MsgBox "Valeurs excédentaires en 'Dest" & i & "'..."
1 Next i
End Sub
Fichier (3).

Corrigez vos erreurs pour que la correspondance soit bonne !

Bonne journée.
 

Pièces jointes

  • diggy(3).xlsm
    3.1 MB · Affichages: 65
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
311 711
Messages
2 081 783
Membres
101 817
dernier inscrit
carvajal