Compteur VBA MergedCells

Bonjour à tous,

J'ai un fichier qui regroupe nos maintenance de produit pour l'année et qui en découle un nombre de personnel à avoir pour l'année, le fichier fonctionne très bien, il y a des Template et un code couleur à respecter, j'ai parfois besoin de 1, 2 ou 1/2 personnes. Le calcul s'effectue bien lors d'un comptage de bloc pour 1 ou 2 personnes mais pas pour les demi-personnes et j'aimerais modifié ce code pour compter, sur certain de nos produits (notamment dans l'onglet "templates", pour les Type 5 et 500S), ces 1/2 personnes et je n'arrive pas du tout à améliorer ce programme.

Si quelqu'un pouvait m'aider à améliorer le code, pour qu'il puisse être opérationnel ce serait fort appréciable.

Merci d'avance.

Bonjour Sirozze,

t'aurais pas attrappé une cirrhose du foie en ayant trop bu lors du réveillon ? pa'c'que tes demi-personnes, ça craint ! tu les coupes en deux dans un remake de « Massacre à la tronçonneuse » ? des demi-journées de travail, je veux bien ; mais des demi-personnes !

j'te souhaite quand même une bonne année 2019, et j'laisse la place à un autre intervenant ; bonne chance !

dhany

Bonjour,

une adaptation de ta fonction, pour pouvoir traiter les demis (hips)

Function MPMergedCells_ColorCode(Domaine As Range) As Long
    Dim Cell As Range
    Dim MergedCell As Range
    Dim FirsCellInRng As Range
    Dim Compteur As Double
    Dim celv, fcir
    For Each Cell In Domaine
        If Cell.Interior.Color = RGB(165, 165, 165) Or Cell.Interior.Color = RGB(0, 176, 80) Or Cell.Interior.Color = RGB(255, 128, 0) Or Cell.Interior.Color = RGB(78, 218, 95) Then
            celv = Trim(Replace(Mid(Cell.Value, (InStrRev(Cell.Value, "-") + 1)), ",", "."))
            If celv <> "" Then
                If celv = Empty Or Not (IsNumeric(celv)) Then
                    Compteur = Compteur
                Else
                    Compteur = Compteur + CDbl(celv)
                End If
            ElseIf Cell.MergeCells Then
                Set MergedCell = Cell.MergeArea
                fcir = MergedCell.Cells(1, 1).Value
                If fcir = "" Then
                    Compteur = Compteur
                Else
                    fcir = Trim(Replace(Mid(fcir, (InStrRev(fcir, "-") + 1)), ",", "."))
                    Compteur = Compteur + CDbl(fcir)
                End If
            Else:    'Do Nothing
            End If
        End If
    Next Cell

    MPMergedCells_ColorCode = Compteur

End Function

Bonjour à tous,

Non je n'ai pas abusé des fêtes en comptant ces demi-personnes, c'est que la réparation du produit ne nécessite pas une personne totalement dévoué à ça pendant la semaine, d'ou la demi personne.

h2so4,

J'ai inséré ton code mais le calcul dans les colonnes du bas me montre une anomalie dans le calcul, serais-tu pourquoi par hasard ?

Bonjour,

voici l'adaptation dans ton fichier, je n'ai pas de problème. Le fichier sur lequel tu essaies est-il le même ?

h2so4,

Sur le fichier je n'avais pas modifié les blocs pour compter les 0.5, je viens de le modifier pour les faire apparaître, désolé c'est de ma faute.

Du coup si tu regardes ce fichier là, la fonction indique un défaut de valeur lors du comptage.

Merci à toi de m'aider.

Bonjour,

pas de problème non plus avec ce fichier (après avoir autorisé les macros)

Merci pour ta réponse h2so4,

ça doit venir de mon coté le problème de valeur du coup je vais regarder.

Merci de ton aide, dans tous les cas.

Bonjour,

si tu confirmes que tu as bien le problème avec le dernier fichier que tu as envoyé, je peux essayer d'investiguer davantage.

Non c'est bon, j'ai fais autrement.

Mais merci d'avoir pris de ton temps pour m'aider, c'est très gentil de ta part.