XL 2013 Recherche + 2 cellules dans 1 cellule

redexcel à dit:

peux-tu renvoyer un fichier et ecricre manuellement ce que tu voudrais voir apparaitre sur la ligne ?

Cliquez pour agrandir...

gosselien à dit:

Bonjour

pour le total c'est assez simple... =SOMMEPROD((Code=A6)*(En_travail)) en cellule T6
Mais il faut nommer tes colonnes ET TOUJOURS leur mettre un titre UNIQUE.
Pour le texte je n'ai pas le temps , sorry

P.

Cliquez pour agrandir...

gosselien à dit:

Je ferai néanmoins la remarque suivante: tes onglets sont particulièrement mal foutus:
une "base de données" doit avoir un titre à chaque colonne (colonne A à F), pas de cellules fusionnées.
Je laisse le soin à d'autres de trouver comment ramener le texte ET les totaux (en VBA c'est possible)
P.

Cliquez pour agrandir...

laurent950 à dit:

Bonsoir,
Correctif sur la BD
Feuil JON 80538.211 et Feuil EC 80538.211 (U) corrigé par 80538.211

La macro est intégré a la feuille de calcul "Fonction personnalisé VBA"

VB:

Function TestBd(Code As String) As String
' recapitulation code
Dim F2 As Worksheet
Set F2 = Worksheets("EC")
TabEC = F2.Range(F2.Cells(4, 1), F2.Cells(F2.Cells(65536, 1).End(xlUp).Row, 22))
    For i = LBound(TabEC, 1) To UBound(TabEC, 1)
        If Code = TabEC(i, 1) Then
            TestBd = Trim(TestBd) & Trim(TabEC(i, 10)) & " = " & Trim(TabEC(i, 17)) & "; "
        End If
    Next i
'MsgBox Left(TestBd, Len(TestBd) - 2)
    ' decoupage pour somme.
    TabSomme = Split(TestBd, "=")
    'MsgBox UBound(TabSomme)
    ' creation tableau pour somme
    Dim TabRes() As Variant
    ReDim TabRes(0 To UBound(TabSomme) - 1, 1 To 2)
        For j = LBound(TabRes, 1) To UBound(TabRes, 1)
            TabRes(j, 1) = Split(Split(TestBd, ";")(j), "=")(0)
            TabRes(j, 2) = Split(Split(TestBd, ";")(j), "=")(1)
        Next j
        j = Empty
    ' Recherche les doublons
    ReDim Preserve TabRes(LBound(TabRes, 1) To UBound(TabRes, 1), LBound(TabRes, 2) To 4)
        For j = LBound(TabRes, 1) To UBound(TabRes, 1)
            For k = j + 1 To UBound(TabRes, 1)
                If TabRes(j, 1) = TabRes(k, 1) Then
                    TabRes(k, 3) = "D"
                End If
            Next k
        Next j
    ' somme
        For j = LBound(TabRes, 1) To UBound(TabRes, 1)
            If TabRes(j, 3) <> "D" Then
                For k = j + 1 To UBound(TabRes, 1)
                    If TabRes(j, 1) = TabRes(k, 1) Then
                        TabRes(j, 2) = CDbl(TabRes(j, 2)) + CDbl(TabRes(k, 2))
                    End If
                Next k
            End If
        Next j
    ' Creation du texte
        TestBd = Empty
        For j = LBound(TabRes, 1) To UBound(TabRes, 1)
            If TabRes(j, 3) <> "D" Then
                TestBd = TestBd & Trim(TabRes(j, 1)) & " = " & Trim(TabRes(j, 2)) & "; "
            End If
        Next j
' MsgBox Left(TestBd, Len(TestBd) - 2)
TestBd = Left(TestBd, Len(TestBd) - 2)

End Function

Ps : Module VBA écrit en vitesse peux être simplifié à tester

Cdt

Cliquez pour agrandir...