Décompter pour faire un tableau de 12 par 12

Bonjour,

Je viens vers vous car malgré mes connaissances et en essayant de faire plusieurs manip, je pense que je ne pars pas sur de bonne base..

Je m'explique : Je voudrais décompter un nombre par colonne et par type de données. Je pense que je ne suis pas clair donc je vous joins un exemple

En gros, je souhaiterai que si face à la case "chien" j'ai 17 ou autres, je veux, si possible en prenant la couleur de l'élement chien, avoir un décompte de 1 à 17 avec écrit chien au dessus. Et que tout se fasse automatiquement même si je change le nombre et le nom de l'animal.. J'ai fais avec des conditions mes tests mais quand je change d'élément et que je suis au 3eme, ca ne fonctionne plus.. Quelqu'un peut m'aider a au moins me lancer ?

Merci par avance pour vos retour

En gros, j'en suis là..

Bonjour,

Avec VBA :

Sub Test()

    Dim Plage As Range
    Dim Cel As Range
    Dim I As Integer
    Dim Lig As Integer
    Dim Col As Integer

    Set Plage = Range("B27:B30")

    Lig = 1
    Col = 1

    For Each Cel In Plage

        For I = 1 To Cel.Offset(, 1).Value

            Cells(Lig, Col).Value = Cel.Value: Cells(Lig + 1, Col).Value = I

            With Range(Cells(Lig, Col), Cells(Lig + 1, Col))

                .Interior.Color = Cel.Interior.Color
                .Borders(7).LineStyle = 1
                .Borders(8).LineStyle = 1
                .Borders(9).LineStyle = 1
                .Borders(10).LineStyle = 1

            End With

            Lig = Lig + 2

            If Lig > 24 Then Col = Col + 1: Lig = 1

        Next I

    Next Cel

End Sub

Bonjour,

Proposition : Evènementielle Change qui réagit automatiquement aux changements de valeurs dans la plage B27:C30.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Plg As Range, i%, j%, k%, m%, n%
    Set Plg = Me.Range("B27:C30")
    If Not Intersect(Target, Plg) Is Nothing Then
        Application.ScreenUpdating = False
        With Me
            With .Range("A1:L24")
                .ClearContents
                .Interior.ColorIndex = xlColorIndexNone
            End With
            For k = 1 To 12
                For i = 1 To 24 Step 2
                    If j = n Then
                        m = m + 1: If m > Plg.Rows.Count Then Exit Sub
                        n = Plg.Cells(m, 2): j = 0
                    End If
                    j = j + 1
                    With .Cells(i, k)
                        .Value = Plg.Cells(m, 1): .Offset(1) = j
                        .Resize(2).Interior.Color = Plg.Cells(m, 1).Interior.Color
                    End With
                Next i
            Next k
        End With
    End If
End Sub

Cordialement.

Je ne sais pas comment vous remercier, ça va m'être extremement utile ! Merci beaucoup je potasse sur ça pour le faire a plus grandes échelles ! L'idée est de faire la même chose sur 4 rectangles identiques de 12x12 mais je pense qu'avec les différents éléments je vais réussir.. enfin je vais tenter mais je vais arrêter de prendre de votre temps ! merci

Bonne continuation.