XL 2010 Recherche de valeurs dans un tableau variable

[mrverger]

Bonjour le forum !

Je sollicite encore votre aide...

Je souhaite extraire des valeurs d'un tableau, pour en constituer un autre, mais ces valeurs ne sont pas toujours sur la même ligne (Nombre de ligne variable entre les valeurs).

J'ai tout explicité dans le fichier ci-joint.

Merci d'avance pour votre aide. N'hésitez pas si besoin de tout complément d'information.

Cordialement,

MrVerger

 

[job75]

Bonjour mrverger,

Vous êtes sûr qu'il faut obtenir "Code production 1" sur les 3 cellules M8 N8 O8 ???

Moi j'aurais plutôt pensé M8="Code production 1", N8="Code production 2", O8="Code production 3"

Même chose pour les lignes suivantes des résultats.

A+

 

[mrverger]

Bonjour Job,

C'est exact ! J'ai corrigé !

Cordialement,

 

[job75]

Je crois comprendre que vous désirez une formule unique qui fonctionne sur tous les tableaux des résultats.

Alors entrez celle-ci en I8 du fichier .xlsm joint :

=Result($B:$B;"Date";C:C;"Code";30)

tirez-la sur I8:K11 et copiez-la sur les tableaux des résultats suivants (I40:K43).

Elle utilise cette fonction VBA à placer impérativement dans un module standard :

Function Result(colref As Range, ref$, coltxt As Range, txt$, h&)
Dim w As Worksheet, lig&, col%, i&, ligdeb&, maxi&, ordre&, n&
txt = txt & "*"
With Application.Caller
    Set w = .Parent
    lig = .Row
    col = .Column
End With
Result = ""
For i = lig To 1 Step -1
    If colref(i) = ref Then ligdeb = i: Exit For
Next
If ligdeb = 0 Then Exit Function
For i = ligdeb To ligdeb + h - 1
    If coltxt(i) Like txt Then maxi = maxi + 1
Next
ordre = 1
For i = lig - 1 To ligdeb Step -1
    If w.Cells(i, col) Like txt Then ordre = ordre + 1
Next
If ordre > maxi Then Exit Function
For i = ligdeb To ligdeb + h - 1
    If coltxt(i) Like txt Then n = n + 1: If n = ordre Then Result = coltxt(i): Exit Function
Next
End Function

A+

 

[mrverger]

Merci beaucoup Job !
Votre solution corresponds à mes attentes.

Je vais tâcher de mettre ça en place dans mon fichier.

A+

 

[mrverger]

Bonjour à tous,
Je relance cette discussion car je ne trouve pas la solution à mon problème.

La solution trouvée la dernière fois par Job fonctionne mais je souhaites améliorer la visibilité de mon document.

Je souhaites afficher les dates correspondantes aux fabrications... tout est expliqué dans le fichier.

Je suis à votre disposition pour toute question !

Cordialement,

MrVerger

 

[job75]

Bonjour mrverger,

Votre dernier fichier en retour avec en H8 =INDEX(B:B;EQUIV(I8;C:C;0)+3)

A+

 

[mrverger]

Bonjour Job,

Merci du temps que vous accordez à mon problème.
Mais la solution proposée ne me permets pas d'atteindre mon objectif.

J'ai modifié le tableau afin de mieux expliciter ma demande.
Je souhaites que la date s'affiche même si il n'y a pas de fabrication prévue.

Merci encore !

Cordialement,

MrVerger

 

[job75]

J'ai complètement revu le code de la fonction et c'est bien mieux ainsi :

Function Result(colref As Range, ref$, coltxt As Range, txt$, h&)
Dim i&, ligdeb&, n&, a$(), j%
txt = txt & "*"
Result = ""
'---recherche de la 1ère ligne---
For i = Application.Caller.Row To 1 Step -1
    If colref(i) = ref Then ligdeb = i: Exit For
Next i
If ligdeb = 0 Then Exit Function
'---recherche des dates---
For i = ligdeb + 1 To ligdeb + h - 1
    If IsDate(colref(i)) Then
        n = n + 1
        ReDim Preserve a(1 To 4, 1 To n)
        a(1, n) = Format(colref(i), "dddd dd-mmmm") 'format date à adapter
        a(1, n) = UCase(Left(a(1, n), 1)) & Mid(a(1, n), 2)
        For j = i - 1 To 1 Step -1
            If IsDate(colref(j)) Then Exit For
            If coltxt(j) Like txt Then
                a(2, n) = coltxt(j)
                a(3, n) = coltxt(j, 2)
                a(4, n) = coltxt(j, 3)
                Exit For
            End If
        Next j
    End If
Next i
If n Then Result = a 'matrice transposée
End Function

Formule unique en H8, du fichier joint, à tirer vers la droite et le bas :

=SIERREUR(INDEX(Result($B:$B;"Date";$C:$C;"Code";30);COLONNES($H8:H8);LIGNES(H$8:H8));"")

 

[mrverger]

Bonsoir Job,

Super travail, on s'approche ! On s'approche !

Encore un problème que je soumet à votre expertise :
Il faut toujours un "Code de production" dans la colonne "Ligne de production 1", ce qui ne sera pas toujours le cas...

J'ai refais un exemple dans lequel le code ne fonctionne pas.

Merci encore pour votre aide précieuse.

Cordialement,

MrVerger

 

[job75]

Fichier joint en remplaçant :

If coltxt(j) Like txt Then

par :

If coltxt(j, 1) Like txt Or coltxt(j, 2) Like txt Or coltxt(j, 3) Like txt Then

Edit : revu la formule en H8 :

=SIERREUR(INDEX(Result($B:$B;"Date";$C:$E;"Code";30);COLONNES($H8:H8);LIGNES(H$8:H8));"")

 

[job75]

Bonjour mrverger, le forum,

Eh bien voici une solution beaucoup plus logique, plus simple et plus rapide :

Function Result(plage As Range)
Dim tablo, a$(), i&, n&, j%
tablo = plage 'matrice, plus rapide
ReDim a(1 To Application.Count(plage.Columns(1)), 1 To 4)
For i = 1 To UBound(tablo)
    If IsDate(tablo(i, 1)) Then
        n = n + 1
        a(n, 1) = Format(tablo(i, 1), "dddd dd-mmmm") 'format date à adapter
        a(n, 1) = UCase(Left(a(n, 1), 1)) & Mid(a(n, 1), 2)
        For j = 2 To 4: a(n, j) = tablo(i, j): Next j
    End If
Next i
Result = a 'matrice
End Function

Les dates sont sur les mêmes lignes que les codes de production, dans des cellules fusionnées.

Formule en H8 :

=SIERREUR(INDEX(Result($B$4:$E$27);LIGNES(H$8:H8);COLONNES($H8:H8));"")

Fichier (2).

Bonne journée.

 

[job75]

Ceci est encore mieux :

Function Result(plage As Range, ligne&)
Dim tablo, a$(1 To 4), i&, n&, j%
tablo = plage 'matrice, plus rapide
For i = 1 To UBound(tablo)
    If IsDate(tablo(i, 1)) Then
        n = n + 1
        If n = ligne Then
            a(1) = Format(tablo(i, 1), "dddd dd-mmmm") 'format date à adapter
            a(1) = UCase(Left(a(1), 1)) & Mid(a(1), 2)
            For j = 2 To 4: a(j) = tablo(i, j): Next j
            Exit For
        End If
    End If
Next i
Result = a 'matrice ligne
End Function

Dans ce fichier (3), sélectionnez la plage H8:K8, entrez cette formule dans la barre de formule :

=Result($B$4:$E$27;LIGNES(H$8:H8))

Validez matriciellement par Ctrl+Maj+Entrée puis tirez la plage vers le bas.

Le recalcul des formules est 15 fois plus rapide qu'avec le fichier (2)...

 

[job75]

Le format des dates en colonne B ne me plaisait pas, alors voyez ce fichier (3 bis) et la macro dans le code de la feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Application.EnableEvents = False 'désactive les évènements
On Error Resume Next 'si aucune SpecialCell
For Each c In [B:B].SpecialCells(xlCellTypeConstants, 1)
    If IsDate(c) Then c = Application.Proper(Format(c, "dddd")) & vbLf & Format(c, "dd-mmmm")
Next
Application.EnableEvents = True 'réactive les évènements
End Sub

Les dates entrées au format jj/mm sont immédiatement converties en textes.

Bien entendu le code de la fonction est modifié en conséquence :

Function Result(plage As Range, ligne&)
Dim tablo, a$(1 To 4), i&, n&, j%
tablo = plage 'matrice, plus rapide
For i = 1 To UBound(tablo)
    If tablo(i, 1) <> "" Then
        n = n + 1
        If n = ligne Then
            a(1) = Replace(tablo(i, 1), vbLf, " ")
            For j = 2 To 4: a(j) = tablo(i, j): Next j
            Exit For
        End If
    End If
Next i
Result = a 'matrice ligne
End Function