Excel - VBA - Reconnaissance d'une céllule

gerald13500 Messages postés 2 Statut Membre -  
lermite222 Messages postés 9042 Statut Contributeur -
Bonjour,

Avec mon faible niveau de programmation je m'efforce de créer un programme qui compte les différentes cellules de couleurs dans un tableau et qui compte les cellules qui sont encadrées en bordure épaisse.

Par exemple :
cellule A1 rouge - je dois obtenir 1 dans la cellule B1
celle A2 encadrée - je dois obtenir 1 dans la cellule B2
celle A3 encadrée et rouge - je dois obtenir obtenir +1 dans B1 et +1 dans la cellule B2

Voici un début de programme qui fonctionne pour le comptage des couleurs :

Sub cptcouleur()

Dim cpt As Long
Dim cpt1 As Long
Dim cpt2 As Long

cpt = 0
cpt1 = 0
For i = 1 To 60
For j = 1 To 60
If Cells(i, j).Interior.ColorIndex = 3 Then
cpt = cpt + 1
ElseIf Cells(i, j).Interior.ColorIndex = 6 Then
cpt1 = cpt1 + 1

End If

Next j
Next i
Range("A1").Value = cpt
Range("B1").Value = cpt1

End Sub

Il suffit que mette en place plusieurs compteur pour toutes les couleurs à compter.

Par contre pour les cellules encadrées, j'ai enregistré une macro.

Voici la macro
Sub Macro3()
'
' Macro3 Macro
'

'
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub

Je n'arrive pas l'intégrer dans un boucle pour faire compter les bordures et donc lui faire reconnaitre une cellule.

Merci de m'aider si vous avez une solution.EXCE

4 réponses

  1. Info
     
    Bonjour,

    Peut-être comme ceci : ??? 

    Option Explicit

Sub CompteCellules()

    Dim Cpt As Long, I As Long, J As Long
        Dim Flag As Boolean

    Application.ScreenUpdating = False

    Flag = False
    Cpt = 0
    For I = 1 To 60
        For J = 1 To 60
            Cells(I, J).Select
            With Selection
                If (.Borders(xlEdgeLeft).LineStyle = xlContinuous) Then
                    Flag = True
                Else
                    Flag = False
                End If
                If (.Borders(xlEdgeTop).LineStyle = xlContinuous And Flag) Then
                    Flag = True
                Else
                    Flag = False
                End If
                If (.Borders(xlEdgeBottom).LineStyle = xlContinuous And Flag) Then
                    Flag = True
                Else
                    Flag = False
                End If
                If (.Borders(xlEdgeRight).LineStyle = xlContinuous And Flag) Then
                    Flag = True
                Else
                    Flag = False
                End If
                
                If (Flag) Then
                    Cpt = (Cpt + 1)
                End If
            End With
        Next J
    Next I

    Application.ScreenUpdating = True
    MsgBox CStr(Cpt)

End Sub
'


    Info
    0
  2. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    Bonjour,
    Remarques,
    tu commence à la ligne 1 mais tu met les résultats dans cette même ligne ??
    Tu veux compter sur 60 colonnes ?? 
    Sub Compter() 
Dim Lig As Long, Col As Integer 
    For Lig = 2 To 60 
        For Col = 1 To 60 
            If Cells(Lig, Col).Interior.ColorIndex <> xlNone Then [A1] = [A1] + 1 
            If Cells(Lig, Col).Borders(xlEdgeLeft).LineStyle <> xlNone Then [B1] = [B1] + 1 
        Next Col 
    Next Lig 
End Sub

    A+
    L'expérience instruit plus sûrement que le conseil. (André Gide)
    Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)
    NOTE : Je ne répond pas aux MP pour les questions techniques.
    Ça doit se passer sur le forum pour que tous puisse y participer ou en profiter.
    0
  3. gerald13500 Messages postés 2 Statut Membre
     
    Bonjour,

    je viens d'utiliser votre méthode.
    Elle marche bien.

    Mais maintenant, je souhiate qu'Excel fasse la différence entre une cellule encadrée (xlmedium) en noir et un cellule encardrée en Rouge (Xl medium).

    Voici mon code, PB Excel ne fait pas la différence (où est mon erreur).

    Sub CompteurCouleurs_CompteurBordures()

    '********** DECLARATION DES VARAIBLES **********.

    Dim Cpt9 As Long
    Dim Cpt10 As Long

    Dim Feedback1 As Boolean
    Dim Feedback2 As Boolean
    Dim I As Long
    Dim J As Long

    '********** INITIALISATION DES VARIABLES **********.

    Cpt9 = 0
    Cpt10 = 0

    Feedback1 = False
    Feedback2 = False

    For I = 1 To 30
    For J = 1 To 30

    Cells(I, J).Select

    With Selection

    '********** CELLULE ENCADREE NOIRE **********.
    If (.Borders(xlEdgeTop).LineStyle = xlContinuous And (.Borders(xlEdgeTop).Weight = xlMedium)) Then
    Feedback1 = True
    Else
    Feedback1 = False
    End If

    If (.Borders(xlEdgeRight).LineStyle = xlContinuous And Feedback1 And (.Borders(xlEdgeRight).Weight = xlMedium)) Then
    Feedback1 = True
    Else
    Feedback1 = False
    End If

    If (.Borders(xlEdgeBottom).LineStyle = xlContinuous And Feedback1 And (.Borders(xlEdgeBottom).Weight = xlMedium)) Then
    Feedback1 = True
    Else
    Feedback1 = False
    End If

    If (.Borders(xlEdgeLeft).LineStyle = xlContinuous And Feedback1 And (.Borders(xlEdgeLeft).Weight = xlMedium)) Then
    Feedback1 = True
    Else
    Feedback1 = False
    End If

    If (Feedback1) Then
    Cpt9 = Cpt9 + 1
    End If
    '********** CELLULE ENCADREE ROUGE **********.
    If (.Borders(xlEdgeTop).LineStyle = xlContinuous And (.Borders(xlEdgeTop).Weight = xlMedium) And (.Borders(xlEdgeTop).Color = 255)) Then
    Feedback2 = True
    Else
    Feedback2 = False
    End If

    If (.Borders(xlEdgeRight).LineStyle = xlContinuous And (.Borders(xlEdgeRight).Weight = xlMedium) And Feedback2 And (.Borders(xlEdgeRight).Color = 255)) Then
    Feedback2 = True
    Else
    Feedback2 = False
    End If

    If (.Borders(xlEdgeBottom).LineStyle = xlContinuous And (.Borders(xlEdgeBottom).Weight = xlMedium) And Feedback2 And (.Borders(xlEdgeBottom).Color = 255)) Then
    Feedback2 = True
    Else
    Feedback2 = False
    End If

    If (.Borders(xlEdgeLeft).LineStyle = xlContinuous And (.Borders(xlEdgeLeft).Weight = xlMedium) And Feedback2 And (.Borders(xlEdgeLeft).Color = 255)) Then
    Feedback2 = True
    Else
    Feedback2 = False
    End If

    If (Feedback2) Then
    Cpt10 = Cpt10 + 1
    End If

    end with

    Next J
    Next I

    End sub
    0
  4. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    Hummmm, bien long tout ça, que pense tu de mon poste ?
    0

Discussions similaires

Excel formule : savoir si une cellule contient partie texte
plunderer007 -
francois -

14 réponses