Probleme variable quand #REF! ou #N/A

Attila451

XLDnaute Occasionnel
Bonjour, j'ai une boucle qui tourne très bien par contre, dès que j'ai un problème de référence style #REF! ou #N/A, la variable plante, j'ai essayé variant et toutes les autres et à chaque fois ça bug.
Quelqu'un aurait il une solution svp. Je joints un tableau simplifié mais celui d'origine et bien plus conséquent.
Merci d'avance !
 

Pièces jointes

  • mettre en couleur une plage de cellules.xlsm
    14.8 KB · Affichages: 30

Dranreb

XLDnaute Barbatruc
Et pour avoir une couleur différente pour chaque type de donnée :
VB:
Sub cou()
Dim Cel As Range
For Each Cel In [A4].CurrentRegion
   Select Case VarType(Cel.Value)
      Case vbString:    Cel.Interior.Color = &HFFE9B9
      Case vbDouble:    Cel.Interior.Color = &HDBFFB1
      Case vbCurrency:  Cel.Interior.Color = &HADFFD2
      Case vbDate:      Cel.Interior.Color = &HADECFD
      Case vbBoolean:   Cel.Interior.Color = &HD2CCFF
      Case vbError:     Cel.Interior.Color = &HF6AFFA
      Case vbEmpty:     Cel.Interior.Color = &HFFC6D4
      End Select: Next Cel
End Sub
 

Attila451

XLDnaute Occasionnel
Bonjour Dranreb,
Merci pour le 1er code, ça fonctionne. Par contre, en étendant la routine à mon "gros tableau", ça ne fonctionne plus: j'ai un tableau Feuil 1 et un autre Feuil2, je cherche à mettre en rouge les cellules Feuil1 qui sont différentes de celles Feuil2. Le problème vient de mes "if" ou si j'intègre Not IsEmpty, la différence n'est plus constatée et si par contre, je ne mets pas Not IsEmpty, les différences se mettent bien en rouge mais ça plante dès qu'il y a un #Ref!
J'ai rajouté un remplacer #Ref! par 0 dans mon autre fichier mais j'aimerais bien comprendre l'erreur.
Merci d'avance!
 

Pièces jointes

  • mettre en couleur une plage de cellules.xlsm
    21.5 KB · Affichages: 28

Dranreb

XLDnaute Barbatruc
Alors évitez de comparer les cellules si au moins une des deux est en erreur.
IsError(Cellule.Value)

Remarquez vous pouvez peut être utiliser une Function pour dissocier les problèmes :
VB:
Function Différents(ByVal C1, ByVal C2) As Boolean
If TypeOf C1 Is Excel.Range Then C1 = C1.Value
If TypeOf C2 Is Excel.Range Then C2 = C2.Value
If VarType(C1) <> VarType(C2) Then Différents = True: Exit Function
If IsError(C1) Then Différents = CLng(C1) <> CLng(C2): Exit Function
Différents = C1 <> C2
End Function
Et dans la procédure principale :
VB:
If Différents(Feuil1.Cells(L, C), Feuil2.Cells(L, C)) Then Feuil1.Cells(L, C).Interior.Color = RGB(200, 0, 0)
Ceci marche bien, par exemple :
VB:
Sub cou()
Dim Plg1 As Range, Plg2 As Range, L As Long, C As Long
Set Plg2 = Intersect(Feuil2.[4:1000000], Feuil2.UsedRange)
Set Plg1 = Feuil1.Range(Plg2.Address)
For L = 1 To Plg2.Rows.Count: For C = 1 To Plg2.Columns.Count
  Plg1(L, C).Interior.Color = IIf(Différents(Plg1(L, C), Plg2(L, C)), &H8592FF, &HBABABA)
  Next C, L
End Sub

Function Différents(ByVal C1, ByVal C2) As Boolean
If TypeOf C1 Is Excel.Range Then C1 = C1.Value
If TypeOf C2 Is Excel.Range Then C2 = C2.Value
If VarType(C1) <> VarType(C2) Then Différents = True: Exit Function
If IsError(C1) Then Différents = CLng(C1) <> CLng(C2): Exit Function
Différents = C1 <> C2
End Function
 
Dernière édition:

Attila451

XLDnaute Occasionnel
Bonjour,

Merci pour toutes ces propositions ! mais ça dépasse mes maigres compétences... Je ne vais faire que du copié collé...
J'ai en fait intégré une autre boucle:
For Each C In Worksheets("Feuil1").Range("A5:d15")
If IsError(C) Then C = 0
Next C

Qui me remplace les erreurs par 0. Ca semble fonctionner.
En tout cas merci encore pour votre temps et votre aide !
Maintenant c'est ricard ;)
Bonne soirée
 

job75

XLDnaute Barbatruc
Bonjour Attila451, Bernard, le forum,

Je n'aime pas voir un fil se terminer en queue de poisson.

En regardant bien chaque ligne Attila451 vous devriez être capable de comprendre ce code :
Code:
Sub Comparaison()
'Feuil1 et Feuil2 sont les CodeNames des feuilles
Dim r As Range
Call RAZ
Set r = Feuil1.Range(Feuil1.UsedRange, Feuil2.UsedRange.Address)
For Each r In r
  If CStr(r) <> CStr(Feuil2.Range(r.Address)) Then
    r.Interior.ColorIndex = 38 'rose
    Feuil2.Range(r.Address).Interior.ColorIndex = 38  'rose
  End If
Next
End Sub

Sub RAZ()
Feuil1.Cells.Interior.ColorIndex = xlNone
Feuil2.Cells.Interior.ColorIndex = xlNone
End Sub
La fonction CStr convertit toutes les valeurs en textes, même les valeurs d'errreur.

Fichier joint.

Bonne journée.
 

Pièces jointes

  • mettre en couleur une plage de cellules(1).xlsm
    29.2 KB · Affichages: 28

job75

XLDnaute Barbatruc
Re,

Evidemment comme les cellules sont traitées une par une la macro n'est pas hyper rapide.

Pour tester j'ai copié pour les 2 feuilles la plage A1:G13 sur A1: G13000.

La macro s'exécute chez moi sur Win 10 - Excel 2013 en 2,3 secondes, ce n'est pas trop mal.

A+
 

job75

XLDnaute Barbatruc
Re,

Voici une solution très rapide utilisant une mise en forme conditionnelle (MFC).

Elle fonctionne quelle que soit la version Excel :
Code:
'Feuil1 et Feuil2 sont les CodeNames des feuilles

Sub RAZ()
Feuil1.Cells.FormatConditions.Delete
Feuil2.Cells.FormatConditions.Delete
Feuil1.Cells.Interior.ColorIndex = xlNone
Feuil2.Cells.Interior.ColorIndex = xlNone
End Sub

Sub Comparaison_MFC()
Dim F As Object
Set F = ActiveSheet
Application.ScreenUpdating = False
Call RAZ
Call MFC(Feuil1, Feuil2)
Call MFC(Feuil2, Feuil1)
F.Activate
Application.ScreenUpdating = True
End Sub

Sub MFC(F1 As Worksheet, F2 As Worksheet)
Dim sel As Range
F1.Activate
ActiveCell.Activate 'si un objet est sélectionné
Set sel = Selection
F1.Range(F1.UsedRange, F2.UsedRange.Address).Select
Selection.FormatConditions.Add xlExpression, Formula1:="=Test(" & Selection(1).Address(0, 0) & ")"
Selection.FormatConditions(1).Interior.ColorIndex = 38 'rose
sel.Select
End Sub

Function Test(c As Range) As Boolean
Test = CStr(Feuil1.Range(c.Address)) <> CStr(Feuil2.Range(c.Address))
End Function
L'exécution étant très rapide on peut faire appeler la macro par les Worksheet_Change.

Fichier joint + fichier de test avec 13 000 lignes pour tester cette solution et la précédente.

A+
 

Pièces jointes

  • Comparaison_MFC(1).xlsm
    32.3 KB · Affichages: 25
  • Comparaison_MFC Test 13000 lignes(1).xlsm
    588.9 KB · Affichages: 24
Dernière édition:

Discussions similaires

Réponses
16
Affichages
409
Réponses
20
Affichages
739