XL 2010 Différence dans cellules ( Résolu )

[Kael_88]

Le forum,

Me revoici avec deux problèmes sans modifier les cellules et en cliquant sur le bouton "Diff" :

Problème 1 :
Si la somme de la cellule en C est différent de la somme de la cellule en F de la même ligne colorier la cellule B en rouge.

Problème 2 :
Si dans la même cellule en G les séries de chiffres sont différentes les unes des autres colorier cette cellule en rouge

Cordialement

 

[job75]

Bonjour Kael_88,

Voyez le fichier joint et ce code :

Sub Diff()
Dim i&, s, j%
With ActiveSheet.UsedRange.Offset(1)
    Union(.Columns(2), .Columns(7)).Interior.ColorIndex = xlNone 'RAZ
    For i = 1 To .Rows.Count - 1
        If MySum(.Cells(i, 3)) <> MySum(.Cells(i, 6)) Then .Cells(i, 2).Interior.Color = vbRed
        s = Split(.Cells(i, 7), vbLf)
        For j = 1 To UBound(s)
            If s(j) <> s(0) Then .Cells(i, 7).Interior.Color = vbRed: Exit For
    Next j, i
End With
End Sub

Function MySum(t$)
Dim i%, deb%
For i = 1 To Len(t) + 1
  If deb = 0 And IsNumeric(Mid(t, i, 1)) Then deb = i
  If deb And Not IsNumeric(Mid(t, i, 1)) Then
  MySum = MySum + CDbl(Mid(t, deb, i - deb))
  deb = 0
  End If
Next
End Function

A+

 

[Staple1600]

Bonsoir le fil, le forum, Kael_88, job75

J'en étais resté là

Sub Probleme1()
Dim wf As WorksheetFunction: Set wf = Application.WorksheetFunction
Dim lg&, X, Y
lg = Cells(Rows.Count, "B").End(3).Row
For i = 2 To lg
X = Evaluate(wf.Substitute(Cells(i, "C"), Chr(10), "+"))
Y = Evaluate(wf.Substitute(Cells(i, "F"), Chr(10), "+"))
If IIf(IsError(X), 0, X) <> IIf(IsError(Y), 0, Y) Then
Cells(i, 2).Interior.ColorIndex = 3
End If
Next
End Sub

Après avoir lu, ton code, job75, je continue à en rester là

 

[Kael_88]

Le forum ,@job75 ,@Staple1600

merci à vous,

@job75 rien à dire comme d'habitude, fonctionne nickel.

Problème résolu.

Cordialement

 

[job75]

Bonjour Kael_88, JM,

Après avoir lu, ton code, job75, je continue à en rester là

Tu as tort JM car tester avec ma fonction MySum est 4 à 10 fois plus rapide que tes Evaluate :

Sub Probleme1()
Dim t, lig&, n, wf As WorksheetFunction: Set wf = Application.WorksheetFunction
Dim X, Y, test As Boolean
t = Timer
lig = 7
For n = 1 To 10000
X = Evaluate(wf.Substitute(Cells(lig, "C"), Chr(10), "+"))
Y = Evaluate(wf.Substitute(Cells(lig, "F"), Chr(10), "+"))
test = IIf(IsError(X), 0, X) <> IIf(IsError(Y), 0, Y)
Next
MsgBox Format(Timer - t, "0.00") & " x 10000 seconde"
End Sub

Sub Diff()
Dim t, lig&, n, test As Boolean
t = Timer
lig = 7
For n = 1 To 10000
    test = MySum(Cells(lig, 3)) <> MySum(Cells(lig, 6))
Next
MsgBox Format(Timer - t, "0.00") & " x 10000 seconde"
End Sub

Function MySum(t$)
Dim i%, deb%
For i = 1 To Len(t) + 1
  If deb = 0 And IsNumeric(Mid(t, i, 1)) Then deb = i
  If deb And Not IsNumeric(Mid(t, i, 1)) Then
  MySum = MySum + CDbl(Mid(t, deb, i - deb))
  deb = 0
  End If
Next
End Function

A+

 

[Staple1600]

Bonjour job75

@job75
Je me suis mal exprimé ou tu m'as mal compris
Quand je disais que j'en restais là, cela voulait dire que je ne chercherais pas à traiter le problème N°2 à ma sauce.
Puisque ton code traite le problème 1 et 2 dans la même procédure, il était inutile (sauf pour le plaisir de cogiter) pour moi de titiller cette question plus avant.
J'aurai donc du plutôt écrire:
"Après avoir lu ton code, je ne vais pas plus loin"

 

[job75]

Re, pas de problème JM,

Dans mes posts #2 et #5 je viens de corriger le code de MySum, la variable flag était inutile.

Voyez maintenant ce fichier (2) qui généralise le problème avec des nombres "décimaux" en F2 et F4.

Je découvre en même temps que le renvoi à la ligne vbLf n'est pas un bon séparateur de nombres, dans cette macro il faut le remplacer par "x" :

Function MySum(t$)
Dim i%, deb%
t = Replace(t, ".", Mid(0.1, 2, 1)) 'séparateur décimal
t = Replace(t, vbLf, "x") & "x" 'vbLf ne délimite pas les nombres
For i = 1 To Len(t)
    If deb = 0 And IsNumeric(Mid(t, i, 1)) Then
        deb = i
    ElseIf deb Then
        If Not IsNumeric(Mid(t, deb, i - deb + 1)) Then
            MySum = MySum + CDbl(Mid(t, deb, i - deb))
            deb = 0
        End If
    End If
Next
End Function

A+

 

[Kael_88]

Le forum ,@job75 ,@Staple1600,

@job75 , dans ton code à la ligne :

 If MySum(.Cells(i, 3)) <> MySum(.Cells(i, 6)) Then .Cells(i, 2).Interior.Color = vbRed

je colorie la cellule en colonne 2 en rouge, mais peut-on en même temps mettre "Erreur" dans la cellule colonne 9, stp ?

j'y arrive en modifiant ton code comme suit :

  If MySum(.Cells(i, 3)) <> MySum(.Cells(i, 6)) And MySum(.Cells(i, 3)) <> "" And MySum(.Cells(i, 6)) <> "" Then
            With .Cells
                .Cells(i, 2).Interior.ColorIndex = "3"
                .Cells(i, 9) = "Erreur"
            End With
        End If

peut être y a t il plus simple ?

merci

Cordialement

Sub Diff()
Dim i&, s, j%
With ActiveSheet.UsedRange.Offset(1)
    Union(.Columns(2), .Columns(7)).Interior.ColorIndex = xlNone 'RAZ
    For i = 1 To .Rows.Count - 1
        If MySum(.Cells(i, 3)) <> MySum(.Cells(i, 6)) Then .Cells(i, 2).Interior.Color = vbRed
        s = Split(.Cells(i, 7), vbLf)
        For j = 1 To UBound(s)
            If s(j) <> s(0) Then .Cells(i, 7).Interior.Color = vbRed: Exit For
    Next j, i
End With
End Sub

Function MySum(t$)
Dim i%, deb%
For i = 1 To Len(t) + 1
  If deb = 0 And IsNumeric(Mid(t, i, 1)) Then deb = i
  If deb And Not IsNumeric(Mid(t, i, 1)) Then
  MySum = MySum + CDbl(Mid(t, deb, i - deb))
  deb = 0
  End If
Next
End Function

 

[Kael_88]

Le forum ,@job75 ,@Staple1600,

@job75 , après avoir fais quelque recherche, je pense avoir trouvé :

 If MySum(.Cells(i, 3)) <> MySum(.Cells(i, 6)) Then .Cells(i, 2).Interior.Color = vbRed

Je colorie la cellule en colonne 2 en rouge et je mets "Erreur" dans la cellule colonne 9.

j'y arrive en modifiant ton code comme suit :

  If MySum(.Cells(i, 3)) <> MySum(.Cells(i, 6)) And MySum(.Cells(i, 3)) <> "" And MySum(.Cells(i, 6)) <> "" Then .Cells(i, 2).Interior.ColorIndex = "3": .Cells(i, 9) = "Erreur"

Cordialement