Excel - VBA - Reconnaissance d'une céllule

Fermé
Messages postés
2
Date d'inscription
vendredi 4 février 2011
Statut
Membre
Dernière intervention
7 février 2011
-
Messages postés
8700
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
-
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

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
Messages postés
8700
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 197
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.
Messages postés
2
Date d'inscription
vendredi 4 février 2011
Statut
Membre
Dernière intervention
7 février 2011

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
Messages postés
8700
Date d'inscription
dimanche 8 avril 2007
Statut
Contributeur
Dernière intervention
22 janvier 2020
1 197
Hummmm, bien long tout ça, que pense tu de mon poste ?