XL 2010 Recherche de valeurs dans un tableau variable

mrverger

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

Pièces jointes

  • Exemple 1.xlsx
    13 KB · Affichages: 8

job75

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

job75

XLDnaute Barbatruc
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 :
Code:
=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 :
VB:
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+
 

Pièces jointes

  • Exemple(1).xlsm
    28.2 KB · Affichages: 10

mrverger

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

Pièces jointes

  • Exemple2 avec date.xlsm
    20.9 KB · Affichages: 3

mrverger

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

Pièces jointes

  • Exemple2 avec date 2.xlsm
    20.9 KB · Affichages: 3

job75

XLDnaute Barbatruc
J'ai complètement revu le code de la fonction et c'est bien mieux ainsi :
VB:
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 :
Code:
=SIERREUR(INDEX(Result($B:$B;"Date";$C:$C;"Code";30);COLONNES($H8:H8);LIGNES(H$8:H8));"")
 

Pièces jointes

  • Exemple2 avec date(1).xlsm
    28.5 KB · Affichages: 4

mrverger

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

Pièces jointes

  • Exemple3 avec date(1).xlsm
    21.5 KB · Affichages: 3

job75

XLDnaute Barbatruc
Fichier joint en remplaçant :
VB:
If coltxt(j) Like txt Then
par :
VB:
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 :
Code:
=SIERREUR(INDEX(Result($B:$B;"Date";$C:$E;"Code";30);COLONNES($H8:H8);LIGNES(H$8:H8));"")
 

Pièces jointes

  • Exemple3 avec date(1).xlsm
    28.6 KB · Affichages: 4
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour mrverger, le forum,

Eh bien voici une solution beaucoup plus logique, plus simple et plus rapide :
VB:
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 :
Code:
=SIERREUR(INDEX(Result($B$4:$E$27);LIGNES(H$8:H8);COLONNES($H8:H8));"")
Fichier (2).

Bonne journée.
 

Pièces jointes

  • Exemple3 avec date(2).xlsm
    27.4 KB · Affichages: 4
Dernière édition:

job75

XLDnaute Barbatruc
Ceci est encore mieux :
VB:
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 :
Code:
=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)...
 

Pièces jointes

  • Exemple3 avec date(3).xlsm
    27.7 KB · Affichages: 3
Dernière édition:

job75

XLDnaute Barbatruc
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 :
VB:
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 :
VB:
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
 

Pièces jointes

  • Exemple3 avec date(3 bis).xlsm
    29.5 KB · Affichages: 6
Dernière édition:

Discussions similaires

Réponses
7
Affichages
228
Réponses
6
Affichages
88
M
Réponses
9
Affichages
449
Maikales
M

Statistiques des forums

Discussions
311 725
Messages
2 081 941
Membres
101 847
dernier inscrit
Djigbenou