Excel - VBA - Reconnaissance d'une céllule

gerald13500 Messages postés 2 Date d'inscription Statut Membre Dernière intervention -
lermite222 Messages postés 8724 Date d'inscription Statut Contributeur Dernière intervention - 7 févr. 2011 à 12:12

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

Afficher la suite

A voir également:

Excel - VBA - Reconnaissance d'une céllule
Excel cellule couleur si condition texte - Guide
Liste déroulante excel - Guide
Excel compter cellule couleur sans vba - Guide
Proteger cellule excel - Guide
Aller à la ligne dans une cellule excel - Guide

4 réponses

Réponse 1 / 4

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

Réponse 2 / 4

lermite222 Messages postés 8724 Date d'inscription Statut Contributeur Dernière intervention 1 191

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.

Réponse 3 / 4

gerald13500 Messages postés 2 Date d'inscription Statut Membre Dernière intervention

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

Réponse 4 / 4

lermite222 Messages postés 8724 Date d'inscription Statut Contributeur Dernière intervention 1 191

Hummmm, bien long tout ça, que pense tu de mon poste ?

Discussions similaires

Excel formule : savoir si une cellule contient partie texte

Votre réponse

Discussions similaires