Bonsoir à tous
Je suis bloqué devant une chose bizarre!
Mon macro sert à rapprocher chaque montant d'un tableau X avec la somme de deux montants d'un tableau Y et s'il les trouvent il les identifient avec un couleur.
EXEMPLE : le TAB X contient un montant = 1000
le TAB Y contient un montant = 700 et un autre de 300
Résultat : les 3 montants figurent avec un tel couleur ....
J'ai réussi à créer ce macro mais le problème qu'il ignore quelque montants.
J'ai essayer de changer ces montants avec d'autres chiffres identiques ( comme l'exemple) , il les acceptent !!! Donc le soucie est dans les montants ( forme , fond , exactitude ... )
j'ai tout pour faire harmoniser tous les chiffres, par exemple j'ai ajouté la possibilité d'arrondir tout les montants pour qu'ils soient compatibles et encore le problème persiste !
Vraiment je suis bloqué devant cet impasse.
Voila mon fichier EXCEL contenant le macro et les deux tableaux : ( le prob dans : les cellules C12 , G17 et G20 )
Merci de m'aider.
Ceci est mon code : ( juste pour info pour ceux qu'il veulent voir que le code VBA : le tableau X couvre de A1 à C16 , le TAB Y couvre du E1 à H22 pour le moment ... et que les 2 premiers lignes de chaque TAB sont des titres ..)
Code :
Je suis bloqué devant une chose bizarre!
Mon macro sert à rapprocher chaque montant d'un tableau X avec la somme de deux montants d'un tableau Y et s'il les trouvent il les identifient avec un couleur.
EXEMPLE : le TAB X contient un montant = 1000
le TAB Y contient un montant = 700 et un autre de 300
Résultat : les 3 montants figurent avec un tel couleur ....
J'ai réussi à créer ce macro mais le problème qu'il ignore quelque montants.
J'ai essayer de changer ces montants avec d'autres chiffres identiques ( comme l'exemple) , il les acceptent !!! Donc le soucie est dans les montants ( forme , fond , exactitude ... )
j'ai tout pour faire harmoniser tous les chiffres, par exemple j'ai ajouté la possibilité d'arrondir tout les montants pour qu'ils soient compatibles et encore le problème persiste !
Vraiment je suis bloqué devant cet impasse.
Voila mon fichier EXCEL contenant le macro et les deux tableaux : ( le prob dans : les cellules C12 , G17 et G20 )
Merci de m'aider.
Ceci est mon code : ( juste pour info pour ceux qu'il veulent voir que le code VBA : le tableau X couvre de A1 à C16 , le TAB Y couvre du E1 à H22 pour le moment ... et que les 2 premiers lignes de chaque TAB sont des titres ..)
Code :
VB:
Sub rapproch()
'Arrondissement chiffre TAB X
NBB = Range(Range("A1"), Range("A1").End(xlDown)).Rows.Count + 1
Range("D3").Select
ActiveCell.FormulaR1C1 = "=ROUND(RC[-1],3)"
Range("D3").Select
Selection.AutoFill Destination:=Range("D3", "D" & NBB - 2)
Range("D3", "D" & NBB - 2).Copy
Range("C3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D3").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.ClearContents
'Arrondissement chiffre TAB Y
NBBB = Range(Range("E1"), Range("E1").End(xlDown)).Rows.Count + 1
Range("I3").Select
ActiveCell.FormulaR1C1 = "=ROUND(RC[-2],3)"
Range("J3").Select
ActiveCell.FormulaR1C1 = "=ROUND(RC[-2],3)"
Range("I3:J3").Select
Selection.AutoFill Destination:=Range("I3", "J" & NBBB - 2)
Range("I3", "J" & NBBB - 2).Copy
Range("G3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("I:J").Select
Selection.ClearContents
' COLORIAGE
EXT = Range(Range("A1"), Range("A1").End(xlDown)).Rows.Count
COM = Range(Range("E1"), Range("E1").End(xlDown)).Rows.Count
DEBE = 3
DEBC = 3
DAB = 4
DABC = 4
' 3eme boucle
While DEBE < EXT
If Range("C" & DEBE).Interior.ColorIndex = xlColorIndexNone Then
DABC = 4
DEBC = 3
DAB = 4
' 2eme boucle
While DEBC < COM
If Range("C" & DEBE).Interior.ColorIndex = xlColorIndexNone Then
DAB = 4
' 1ere boucle
While DAB < COM
If Range("C" & DEBE).Value = (Range("G" & DEBC).Value + Range("G" & DAB).Value) Then
Range("C" & DEBE).Interior.Color = 255
Range("G" & DEBC).Interior.Color = 255
Range("G" & DAB).Interior.Color = 255
End If
DAB = DAB + 1
If Range("C" & DEBE).Interior.Color = 255 Then DAB = COM
Wend
End If
DEBC = DEBC + 1
DAB = 4
If Range("C" & DEBE).Interior.Color = 255 Then DABC = COM
Wend
End If
DEBE = DEBE + 1
DEBC = 3
DAB = 4
Wend
End Sub