Vous utilisez un navigateur obsolète. Il se peut que ce site ou d'autres sites Web ne s'affichent pas correctement. Vous devez le mettre à jour ou utiliser un navigateur alternatif.
Colorier (mettre en gras) les chiffres qui se matchent
Je galère sur une macro et j'aimerais l'aide du forum pour faire cette macro.
En effet j'ai sur une feuille excel des numéros de series dans une colonne ainsi que les montants 5généralement débit et crédit). J'aimerais que la macro arrivent pour un numéro de serie donné a mettre en gras chaque montant ainsii que son opposé. Et dans le cas ou il ne trouve pas le montant et son opposé alors il ne fait rien bien sur.
Idéalement si la macro pouvait copier sur une autre feuille les valeurs qui mqtchent cela serait parfait.
Ci-joint un fichier qui je l'espère permettra de bien comprendre mon problème et erci beaucoup a ceux qui s'y pencheront.
Re : Colorier (mettre en gras) les chiffres qui se matchent
(re) Bonjour à tous,
Ma formule MFC de mon précédent message était erronée (ça me turlupinait depuis que j'avais publié la première version, je sentais bien que quelque chose clochait)
Toujours le même principe: un essai basé sur une formule de MFC. La macro crée une MFC sur la zone de la Feuil1, filtre sur la couleur et recopie la zone filtrée sur Feuil2.
(R41 est remplacé au sein de la macro par le numéro de la dernière ligne de donnée de Feuil1) Sans la recopie sur Feuil2, le VBA serait inutile et la formule de la MFC suffirait sur la zone A2:B41.
Explication de la formule:
Elle est basée sur le fait que si un couple (A,B) doit être marqué, c'est parce que son couple opposé (A,-B) existe aussi. Pour (A,B) donné, on ne pourra marquer qu'un nombre de couple (A,B) dont les opposés (A,-B) existent aussi. Donc pour un couple (A,B), c'est le minimum entre le nombre de couples (A,B) et de couples (A,-B) qui déterminera le nombre de couples qu'on peut marquer au sein de toute la plage. Soit N ce nombre minimum.
Ensuite en parcourant la zone, si on tombe sur un couple (A,B) ou (A,-B), la ligne sera à marquer si le rang d'apparition du couple est inférieur ou égal au minimum N. Les couples de rang supérieur à N ne sont pas à marquer puisqu'ils n'ont plus d'opposés.
Cette formule pour chaque couple (A,B) recherche le nombre minimum entre le nombre d'apparitions des couples (A,B) et le nombre d'apparitions des couples opposés (A,-B) et cela sur l'ensemble de la zone A2:B41.
Pour le couple de la ligne 2, cela donne:
Ensuite pour chaque ligne de couple (A,B) ou (A,-B), si l'apparition de ce couple à compter de la ligne 2 est inférieur ou égal au MIN trouvé ci-dessus, alors la ligne doit être marquée. Ce qui donne:
Re : Colorier (mettre en gras) les chiffres qui se matchent
bonjour le forum,
Merci beaucoup pour vos solutions, que je prends le temps de tester une a une.
PierreJean merci beaucoup pour tes interventions, pareil 0 Robert et Mapomme.
Par contre mapomme quand je lance ta macro, j4ai un message de procédure non existante, est ce normale?
Merci beaucoup
Ce n'est pas normal, j'ai refait un fichier v2b à tester...
Question 1: Sinon, quand on lance la macro directement depuis l'environnement VBA, cela marche t il ?
Question 2 : D'autres auraient ils le même PB que toi avec la version v2 ?
Décidément quand je fais vite, je fais bêtises sur bêtises. La version v3 qui devrait fonctionner correctement! Je remplaçais R41 au lieu de remplacer $41 suite au changement de formule.
Re : Colorier (mettre en gras) les chiffres qui se matchent
Re
Ma derniere version
Code:
Sub test()
coul = 4
For n = 2 To Range("A" & Rows.Count).End(xlUp).Row
For m = n + 1 To Range("B" & Rows.Count).End(xlUp).Row
If Range("A" & n) = Range("A" & m) And Range("B" & m) = -Range("B" & n) Then
If Range("B" & n).Interior.ColorIndex = xlNone And Range("B" & m).Interior.ColorIndex = xlNone Then
Range("B" & n).Font.ThemeColor = xlThemeColorDark1
Range("B" & m).Font.ThemeColor = xlThemeColorDark1
Range("B" & n).Interior.ColorIndex = coul
Range("B" & m).Interior.ColorIndex = coul
Range("A" & n).Font.ThemeColor = xlThemeColorDark1
Range("A" & m).Font.ThemeColor = xlThemeColorDark1
Range("A" & n).Interior.ColorIndex = coul
Range("A" & m).Interior.ColorIndex = coul
coul = coul + 1
End If
End If
Next
Next
End Sub
Re : Colorier (mettre en gras) les chiffres qui se matchent
Bonjour Mapomme
Moi aussi j'ai eu un probleme avec la nouvelle version 3.
PierreJean, quand je met la nouvelle macro, que je lance excel me dit variable non definie sur coul?
En tout cas merci pour toutes les solutions que je prends.
Idéalement PierreJean avec ta macro si on pouvait avoir sur un autre onglet le recopiage de toutes les données (valeurs) trouvées, ce serait parfait car avec cette macro je parcours souvent 1000 lignes pour voir tous les nombres coloriés.
Merci et ci-joint mon fichier avec lequel j'ai variable non défini.
Re : Colorier (mettre en gras) les chiffres qui se matchent
Merci PierreJean
C'est une erreur de ma part d'avoir colorié deux fois.
La j'ai lancé sur la feuille ca marche parfaitement.
Je vais le tester sur mon projet et je te dirai.
merci sincèrement pour toutes tes propositions.
Ainsi qu'au forum pour les solutions données
Re : Colorier (mettre en gras) les chiffres qui se matchent
Re
Version avec une petite 'coquetterie' : en fonction de la couleur de fond la couleur du texte est soit noire soit blanche pour une meilleure lisibilité
@ mapomme
Chez moi le bug consiste tout simplement en ce que les couleurs ne viennent plus (mais elles sont venues une fois !!!!)
Et j'ai repris le fichier d'origine
NB: pour des raisons bizarres je suis sous XL 2007
Re : Colorier (mettre en gras) les chiffres qui se matchent
Bonsoir,
VB:
Sub test2()
Dim TabOrg() As Variant
Dim Tabcoul As Range
TabOrg = Range(Cells(2, 1), Cells(Cells(65536, 1).End(xlUp).Row, 2))
ReDim Preserve TabOrg(1 To UBound(TabOrg, 1), 1 To 5)
Set Tabcoul = Range(Cells(2, 1), Cells(Cells(65536, 1).End(xlUp).Row, 2))
For i = 1 To UBound(TabOrg, 1)
For j = i + 1 To UBound(TabOrg, 1)
If TabOrg(i, 1) = TabOrg(j, 1) Then
TabOrg(j, 3) = "x"
End If
Next j
Next i
'CLng(xx) = Right(TabOrg(K, 2), Len(TabOrg(K, 2)) - 1)
For i = 1 To UBound(TabOrg, 1)
If TabOrg(i, 3) = "" Then
For j = i To UBound(TabOrg, 1)
For k = i To UBound(TabOrg, 1)
If TabOrg(i, 1) = TabOrg(j, 1) And TabOrg(i, 1) = TabOrg(k, 1) Then
If TabOrg(k, 2) Like "-" & "*" Then
If TabOrg(j, 2) = CLng(Right(TabOrg(k, 2), Len(TabOrg(k, 2)) - 1)) Then
' reperage
TabOrg(j, 4) = "V"
TabOrg(k, 4) = "V"
' couleur
Tabcoul(j, 2).Interior.ColorIndex = k
Tabcoul(k, 2).Interior.ColorIndex = k
End If
End If
End If
Next k
Next j
End If
Next i
'Cells(2, 1).Resize(UBound(TabOrg, 1), UBound(TabOrg, 2)) = TabOrg
End Sub
Ce site utilise des cookies pour personnaliser le contenu, adapter votre expérience et vous garder connecté si vous vous enregistrez.
En continuant à utiliser ce site, vous consentez à notre utilisation de cookies.