Mettre une valeur automatique dans un tableau

Bonjour,

Nouveau sur ce forum,

Je cherche un mettre une valeur avec une formule dans un tableau avec des recherchev ou ( index et equiv )

Merci de votre aide

Bonjour

Solution en PJ

Cdt

Bonjour,

Formule suivante en E10 et à copier vers la droite et vers le bas :

=SOMMEPROD((($B$1:$B$6=$D10)*($A$1:$A$6=E$9)+($A$1:$A$6=$D10)*($B$1:$B$6=E$9))*($C$1:$C$6))

Merci à tous les deux.

bonjour

un essai

la fonction est matricielle

cordialement

Merci Tulipe_4

Il me manquait la valeur en fonction du fruit.

J'ai repris la réponse de Tulipe_4 qui a aussi répondu à ma première demande qui n'était pas complète.

Merci

Pas de solution ?

bnojour

si !!; mais c'est pas de la tarte

trop vicieux pour expliquer

cordialement

Merci Tulip4

J'essayerai de comprendre

Bon après-midi

de rien

je serai curieux de voir une solution a base de TCD

ps):la partie SOMMEPROD sert a renseigner le k de PETITE. VALEUR

cordialement

Bonsoir le fil

Pas très top

Option Explicit

Sub test()
Dim a, b(), i As Long, j As Long, x(), AL As Object, posR, posC
    Set AL = CreateObject("System.Collections.ArrayList")
    a = Sheets(1).Range("a1").CurrentRegion.Value
    For i = 1 To 2
        For j = 2 To UBound(a, 1)
            If Not AL.Contains(a(j, i)) Then AL.Add a(j, i)
        Next
    Next
    ReDim b(1 To AL.Count + 1, 1 To AL.Count + 1)
    For i = 0 To AL.Count - 1
        b(1, i + 2) = AL(i)
        b(i + 2, 1) = AL(i)
    Next
    ReDim x(1 To AL.Count)
    For i = 0 To AL.Count - 1
        x(i + 1) = AL(i)
    Next
    For i = 2 To UBound(a, 1)
        posR = Application.Match(a(i, 2), x, 0)
        posC = Application.Match(a(i, 1), x, 0)
        b(posR + 1, posC + 1) = a(i, 4)
        b(posC + 1, posR + 1) = a(i, 3)
    Next
    Application.ScreenUpdating = False
    With Sheets(2).Cells(1).Resize(UBound(b, 1), UBound(b, 2))
        .CurrentRegion.Clear
        .Value = b
        With .Rows(1)
            With .Offset(, 1).Resize(, .Columns.Count - 1)
                .Interior.ColorIndex = 36
            End With
            .BorderAround Weight:=xlThin
        End With
        With .Columns(1)
            With .Offset(1).Resize(.Rows.Count - 1)
                .Interior.ColorIndex = 43
            End With
        End With
        .BorderAround Weight:=xlThin
        .Borders(xlInsideVertical).Weight = xlThin
        .Font.Name = "calibri"
        .Font.Size = 10
        .VerticalAlignment = xlCenter
        .HorizontalAlignment = xlCenter
        .Columns.ColumnWidth = 15
        .Parent.Activate
    End With
    Set AL = Nothing
    Application.ScreenUpdating = True
End Sub

klin89

Re le forum,

Pas si simple si les données de la feuille source ne sont pas ordonnées

Une solution un peu tordue

Option Explicit
Sub test()
Dim dico As Object, SL As Object, e
Dim a, b(), c(), posR, posC, i As Long, j As Long
    Set dico = CreateObject("Scripting.Dictionary")
    Set SL = CreateObject("System.Collections.SortedList")
    With Sheets(1).Range("a1").CurrentRegion    'feuille source
        a = .Value
        For i = 2 To UBound(a, 1)
            For j = 1 To 2
                dico(a(i, j)) = IIf(j = 1, dico(a(i, j)) + 1, dico(a(i, j)) + 0)
            Next
        Next
        'Détermine l'ordre des en-têtes
        For Each e In dico
            SL(dico(e)) = e
        Next
        ReDim b(1 To SL.Count)
        For i = SL.Count - 1 To 0 Step -1
            b(UBound(b, 1) - i) = SL.GetByIndex(i)
        Next
        'Ecriture dans le tableau final
        ReDim c(1 To UBound(b, 1) + 1, 1 To UBound(b, 1) + 1)
        For i = 1 To UBound(b, 1)
            c(1, i + 1) = b(i)
            c(i + 1, 1) = b(i)
        Next
        For i = 2 To UBound(a, 1)
            posR = Application.Match(a(i, 2), b, 0)
            posC = Application.Match(a(i, 1), b, 0)
            c(posR + 1, posC + 1) = a(i, 4)
            c(posC + 1, posR + 1) = a(i, 3)
        Next
    End With
    Application.ScreenUpdating = False
    'Restitution et mise en forme
    With Sheets(2).Cells(1).Resize(UBound(c, 1), UBound(c, 2))
        .CurrentRegion.Clear
        .Value = c
        With .Rows(1)
            With .Offset(, 1).Resize(, .Columns.Count - 1)
                .Interior.ColorIndex = 36
            End With
        End With
        With .Columns(1)
            With .Offset(1).Resize(.Rows.Count - 1)
                .Interior.ColorIndex = 43
            End With
        End With
        .BorderAround Weight:=xlThin
        .Borders(xlInsideVertical).Weight = xlThin
        .Borders(xlInsideHorizontal).Weight = xlThin
        .Font.Name = "calibri"
        .Font.Size = 10
        .VerticalAlignment = xlCenter
        .HorizontalAlignment = xlCenter
        .Columns.ColumnWidth = 15
        With .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1)
            .SpecialCells(4).Interior.ColorIndex = 15
        End With
        .Parent.Activate
    End With
    Set dico = Nothing: Set SL = Nothing
    Application.ScreenUpdating = True
End Sub

klin89

Merci Tulip4.

Autre question : pourquoi quand je suis dans une cellule du résultat et que je clique dans la formule, la valeur disparaît?

bonjour

pasque la formule est matricielle et, qu'elle nessecite une validation sprciale

1) tu vas a la deniere ) comme si tu voulais rajouter qque chose

2) tu fait les touches Ctrl Maj (la grosse fleche) Entrée les 3 en memetemp

si tu reussis la manip : les { } se mettent et ça remarche

il est vain de chercher à les saisir

cordialement

Merci pour tout tulip4