VBA trouver une cellule qui va taper dans une autre cellule

Version imprimable

Bonjour à tous,

Comme le titre indique, je souhaiterais savoir s'il est possible de sélectionner les cellules qui vont juste faire référence à une autre.
A l'image de l'outil "selectionner les cellules" "formules" mais ici ca me selectionne toutes les formules, hors je veux uniquement les cellules où il y a par exemple =A1 ou =CD32

Voici la macro que j'ai faite pour les cellules contenant "!" faisant référence à une cellule d'une autre feuille par exemple.
Code:

1 2 3 4 5 6 7 8 9 10 11 For i = 1 To 100 ActiveSheet.Cells.Find(What:="!", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Select With Selection.Font .Color = -16777024 .TintAndShade = 0 End With Next
Espérant avoir été claire, merci beaucoup !

Citation:

Envoyé par kikoox

Bonjour,

Essayez ce code :

- Celui-ci cherche d'abord les cellules avec formule : si c'est le cas, la police devient bleue. Ensuite, il cherche les formules contenant le caractère ! et met la police dans une autre couleur.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
 
Sub RepererLesCellulesAvecFormule()
 
Dim I As Long
Dim AireBalayee As Range
 
    Set AireBalayee = ActiveSheet.Range("A1:F100") ' Selon votre aire de recherche
    With AireBalayee.Font
       '  .ColorIndex = xlAutomatic  ' A activer si vous n'avez pas d'autres couleurs de police spécifiques dans l'aire balayée
       '  .Bold = False            ' idem
    End With
    For I = 1 To AireBalayee.Cells.Count
            If InStr(1, AireBalayee(I).FormulaR1C1, "=", vbTextCompare) > 0 Then
               With AireBalayee(I).Font
                    .ThemeColor = xlThemeColorLight2
                    .Bold = True
               End With
            End If
            If InStr(1, AireBalayee(I).FormulaR1C1, "!", vbTextCompare) > 0 Then
               With AireBalayee(I).Font
                     .Color = -16777024
                     .Bold = True
               End With
            End If
    Next I
    Set AireBalayee = Nothing
 
End Sub

Cordialement.

Bonjour

ou ainsi (exemple sur la totalité des cellules, à adapter si sur plage restreinte) :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Dim plage As Range, a As Range, c As Range
  On Error Resume Next ' pour le cas où aucune formule
  For Each a In Cells.SpecialCells(xlCellTypeFormulas).Areas
  On Error GoTo 0
    For Each c In a.Cells
      If c.Formula Like "*!*" Then
        If plage Is Nothing Then
          Set plage = c
        Else
          Set plage = Union(plage, c)
        End If
      End If
    Next
  Next
 If Not plage Is Nothing Then
   With plage.Font
    .Color = -16777024
    .TintAndShade = 0
   End With
 End If

Bonjour,

Avec une solution similaire a celle de unparia :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub test()
    Dim c As Range, rg As Range
        For Each c In Cells.SpecialCells(xlCellTypeFormulas)
            If HavePrecedent(c) Then
                If rg Is Nothing Then
                  Set rg = c
                Else
                  Set rg = Union(rg, c)
                End If
            End If
        Next
        If Not rg Is Nothing Then
            rg.Interior.Color = 255
        End If
fin:
    Set rg = Nothing
End Sub

La différence ce situe dans le test. Je cherche la présence d'antécédent de chaque cellule via la fonction suivante :

Code:

1
2
3
4
5
6
7
8
Function HavePrecedent(ByVal c As Range) As Boolean
    On Error Resume Next
    Dim p As Range
        Set p = c.Precedents
    HavePrecedent = Not p Is Nothing
fin:
    Set p = Nothing
End Function

04/01/2017, 00h36
kikoox

Rapide et efficace !

Bonsoir,

C'est merveilleux, merci beaucoup à tous les 3 !