XL 2013 Rapprochement manquant !!

ayydam

XLDnaute Nouveau
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 :

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
 

Pièces jointes

  • RAPPROCH1.xlsm
    28.4 KB · Affichages: 14

job75

XLDnaute Barbatruc
Bonjour ayydam, bienvenue sur XLD,

Si au lieu du titre bizarre !! qui ne veut rien dire vous aviez mis Rapprochement vous auriez trouvé de nombreuses discussions similaires en bas de page.

Il n'est pas trop tard pour faire cette modification, sinon faites une recherche sur ce mot clé.

A+
 

Dranreb

XLDnaute Barbatruc
Bonjour.
Essayez :
VB:
If Abs(Range("C" & DEBE).Value - Range("G" & DEBC).Value - Range("G" & DAB).Value) < 0.0005 Then
ou bien :
VB:
If CCur(Range("C" & DEBE).Value) = CCur(Range("G" & DEBC).Value + Range("G" & DAB).Value) Then
On a beau arrondir avant à 3 décimales, les valeurs réellement enregistrées ne sont toujours pas conformes à leur représentation en décimal :
AffichéHexadécimalDécimal, mantisse impaireVéritable valeur enregistrée retraduite en décimal
222806,797+&H1,B32B660418937 × 2^+&H0117655583251532087 / 2^35222806,79699999999138526618480682373046875
87687,651+&H1,5687A6A7EF9DB × 2^+&H0106025849492928987 / 2^3687687,650999999998020939528942108154296875
135119,146+&H1,07E792B020C4A × 2^+&H0112321329252533797 / 2^34135119,1460000000079162418842315673828125
222806,797+&H1,B32B660418938 × 2^+&H011956947906441511 / 2^32222806,79700000002048909664154052734375
Le dernier nombre affiché résulte de la somme des deux précédents, et on voit qu'il n'est pas égal au premier.


Mais c'est vrai que Excel, de son coté, sait un peu tricher de façon à ne pas voir de différence, contrairement à VBA. (il est bien obligé de payer d'une autre façon le fait de ne pas utiliser en interne le type de donnée Currency, lequel garantirait toujours 4 décimales exactes.)
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
311 733
Messages
2 082 015
Membres
101 868
dernier inscrit
pierreselo33