XL 2013 Recherche + 2 cellules dans 1 cellule

J

jonwar

XLDnaute Nouveau
Bonjour à toutes et tous et bonne année 2018.

Apres plusieurs heures de recherche, je décide de créer un post pour vous présenter mon problème :

Je souhaiterais afficher dans une cellule le contenu de plusieurs cellule précise parmi un choix de lignes.

Je vous joins un fichier qui je pense sera plus clair que cette description.

Merci
 

Pièces jointes

  • Test.xlsx
    440.1 KB · Affichages: 23
Trier par date Trier par votes
gosselien

gosselien

XLDnaute Barbatruc
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.
 

Pièces jointes

  • Test (7).xlsx
    412.8 KB · Affichages: 19
Vote positif 0 Vote négatif
J

jonwar

XLDnaute Nouveau
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...

Merci pour votre recherche mais j'avais déjà obtenu ce resultat en S6 avec SOMME.SI

La ou je galere c'est pour avoir le détail de ces 379 : a savoir
SATINER + CTRL = 200; LAVER RANG SATIN = 79; SATINER + CTRL = 100
 
Vote positif 0 Vote négatif
gosselien

gosselien

XLDnaute Barbatruc
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.
 
Vote positif 0 Vote négatif
laurent950

laurent950

XLDnaute Accro
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
 

Pièces jointes

  • Test.xlsm
    441.9 KB · Affichages: 21
Vote positif 0 Vote négatif
J

jonwar

XLDnaute Nouveau
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...


MERCI Laurent, je viens de tester et c'est OK.

C'est SUPER !
 
Vote positif 0 Vote négatif

Discussions similaires

E
  • Résolu(e)
Microsoft 365 VBA Function Recherche d'une couleur et renvoi résultats
Réponses
5
Affichages
259
Englobe
E
T
  • Résolu(e)
XL 2010 Formule - Recherche dans tableau
Réponses
2
Affichages
117
tchi456
T
C
  • Résolu(e)
Microsoft 365 Recherche une valeur
Réponses
6
Affichages
109
CathU
C
S
  • Résolu(e)
Microsoft 365 Recherche de date en VBA
Réponses
6
Affichages
226
sylvanu
sylvanu
N
  • Question
Microsoft 365 Déclanchement d'une alarme sonore lorsqu'une cellule est compléter
Réponses
8
Affichages
310
Nino38
N
H
  • Question
Microsoft 365 Calcul d'une somme de données entre 2 dates (1 ancienne et aujourd'hui)
Réponses
13
Affichages
350
Heian911
H
B
  • Résolu(e)
Microsoft 365 Recherche dans tableaux suivant 4 critères
2
Réponses
15
Affichages
432
Blf57
B
O
  • Question
Power Query Convertir un tableau de colonnes en lignes avec plusieurs variables (power query)
Réponses
8
Affichages
364
oobiz
O
P
  • Résolu(e)
XL 2010 Vérifier contenu de même cellules sur plusieurs feuilles
Réponses
7
Affichages
190
Panda79360
P
L
  • Résolu(e)
Microsoft 365 VBA - Attribuer mise en forme en fonction de valeur cellule d'une liste
Réponses
14
Affichages
303
Laliepomm
L

Membres actuellement en ligne

6 membres et 107 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 177
Messages
2 085 972
Membres
103 073
dernier inscrit
MSCHOE16