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
je voudrai que dans visuel il soit rouge aussi
merci a tous d’avance
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
Salutations
JJ
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)
bonjour,
un grand merci a toi jacky67 c'est tout a fait ce qu'il me fallait
RE
Tu es certain de ce résultat ???
Sur 2 energie cellule c4/c5/c6 =4 pour des objets différents
Résultat en feuille 'Visuel"
seul le premier 4 sera pris en compte
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
salut ,
oui c'est bien normal que C4,C5,C6, =4 petite explication
n'est t'il pas possible de faire un "si alors sinon" si le premier est fait, passer a l'autre?
j’espère que mes explication sont claire
merci encore
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 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.
bonsoir
je remercie jacky67 et job75 pour votre patience .
sa a marcher, je vais juste crée une petite macro avec un bouton pour tout effacer d'un coup (oui je vient d’apprendre a le faire sur un site lol)
merci a vous !!!!!!!!!!!
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 !