IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

VBA trouver une cellule qui va taper dans une autre cellule [XL-2013]


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre à l'essai
    Femme Profil pro
    Architecte technique
    Inscrit en
    Janvier 2017
    Messages
    3
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Âge : 27
    Localisation : France, Hauts de Seine (Île de France)

    Informations professionnelles :
    Activité : Architecte technique

    Informations forums :
    Inscription : Janvier 2017
    Messages : 3
    Par défaut VBA trouver une cellule qui va taper dans une autre cellule
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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 !

  2. #2
    Invité
    Invité(e)
    Par défaut
    Citation Envoyé par kikoox Voir le message
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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.

  3. #3
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    Avril 2016
    Messages
    7 563
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 84
    Localisation : France, Pyrénées Atlantiques (Aquitaine)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : Avril 2016
    Messages : 7 563
    Par défaut
    Bonjour

    ou ainsi (exemple sur la totalité des cellules, à adapter si sur plage restreinte) :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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

  4. #4
    Membre Expert Avatar de antonysansh
    Homme Profil pro
    Chargé d'études RH
    Inscrit en
    Mai 2014
    Messages
    1 115
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 34
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : Chargé d'études RH
    Secteur : Finance

    Informations forums :
    Inscription : Mai 2014
    Messages : 1 115
    Par défaut
    Bonjour,

    Avec une solution similaire a celle de unparia :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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

  5. #5
    Membre à l'essai
    Femme Profil pro
    Architecte technique
    Inscrit en
    Janvier 2017
    Messages
    3
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Âge : 27
    Localisation : France, Hauts de Seine (Île de France)

    Informations professionnelles :
    Activité : Architecte technique

    Informations forums :
    Inscription : Janvier 2017
    Messages : 3
    Par défaut Rapide et efficace !
    Bonsoir,

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

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [XL-2013] Une condition qui se manifeste dans une autre cellule
    Par Yepazix dans le forum Excel
    Réponses: 5
    Dernier message: 30/11/2015, 14h27
  2. [XL-2013] Copier cellules en ligne dans une colonne qui se trouve dans un autre classeur
    Par Wushugringo dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 20/02/2015, 09h07
  3. [XL-2007] [débutante VBA] trouver la liste des images utilisée dans une feuille
    Par EmmanuelleC dans le forum Macros et VBA Excel
    Réponses: 4
    Dernier message: 09/10/2009, 14h46
  4. [Syntaxe] Lien d'une frame qui s'ouvre dans une autre
    Par Petrucci dans le forum Balisage (X)HTML et validation W3C
    Réponses: 1
    Dernier message: 02/04/2007, 23h14
  5. Réponses: 2
    Dernier message: 06/02/2007, 10h17

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo