Microsoft 365 Rencenser des dates d'occurences de libéllés dans une Bdd

[spike29]

Bonjour le forum,

J'ai un fichier de suivi qui permet de calculer l'intervalle optimal pour diverses opération logistiques.
Deux feuilles de calculs.
La première, il s'agit d'un tableau de suivi et la seconde un tableau d'ordonnancement des opération logistiques (Variables3)
Avec une méthode Find ou similaire, je souhaite extraire les différentes dates d’occurrences des opérations logistiques reprises dans la colonne A de la Feuil de calcul Suivi, suivi de la mention JOUR/NUIT suivant la colonne ou elle apparaissent dans la feuil de calcul 'Variables3'.
Le résultat apparaîtra dans la colonne J de la Feuil de calcul 'Suivi'. => Détails dans l'encadré 'Besoin1' en haut de la Feuille "Suivi".

S'en suivra ensuite, dans la colonne K de la Feuil 'Suivi' un calcul selon différents critères, de la date optimale pour réaliser ces opérations logistiques.
Détail des critères repris dans mon fichier (Besoin n°2).

Encore désolé pour cette demande assez conséquente mais avec mon maigre niveau en VBA je bloque très vite.

Un début de code que j'ai commencé à manipuler sans trop de succès.

Dim foundRng As Range

With Worksheets("Variables3")


    Set foundRng = Range("B11:K31").Find("TXX1")
    MsgBox foundRng.Address



    Set foundRng = Range("B11:K31").FindNext(foundRng)
    MsgBox foundRng.Address

End With

Merci d'avance pour votre aide.


En PJ un fichier pour illustrer ma demande.


Bonne journée

 

[job75]

Bonjour spike29,

Dans la feuille "Suivi" formule en J10 :

=Recherche_dates(A10;Variables3!B:K)

Formule en K10 :

=SI(M10<>"";"";SI(J10="";SI(JOURSEM(L10)=7;L10-1;SI(JOURSEM(L10)=1;L10-2;""));Derniere_date(J10)))

Ces formules utilisent les fonctions VBA suivantes :

Const sep$ = vbLf 'séparateur mémorisé, modifiable

Function Recherche_dates(critere$, colonnes As Range) As String
Dim d As Object, nlig&, tablo, i&, j%, dat, x$
Set d = CreateObject("Scripting.Dictionary") 'pour éliminer les doublons
d.CompareMode = vbTextCompare 'la casse est ignorée
Set colonnes = Intersect(colonnes, colonnes.Parent.UsedRange.EntireRow)
tablo = colonnes 'matrice, plus rapide
nlig = UBound(tablo)
For j = 2 To UBound(tablo, 2)
    For i = 2 To nlig
        If tablo(i, j) = critere Then
            dat = colonnes(1, j).MergeArea(1)
            If dat >= Date Then
                x = Format(dat, "dd/mm/yyyy") & IIf(colonnes(i, j).Interior.Color = vbWhite, " JOUR", " NUIT")
                If Not d.exists(x) Then d(x) = "": Recherche_dates = Recherche_dates & sep & x
            End If
        End If
Next i, j
Recherche_dates = Mid(Recherche_dates, Len(sep) + 1)
End Function

Function Derniere_date(x$) As Date
Dim s
If x = "" Then Exit Function
s = Split(x, sep)
Derniere_date = Split(s(UBound(s)))(0)
End Function

Leurs codes doivent être impérativement dans un module standard (Module2).

A+

 

[spike29]

Bonjour Job75,

Un grand merci ! Cela fonctionne à merveille chez moi aussi.
Seule précision que je n'ai pas pensé préciser dans mon fichier et ma demande.
Dans la plage de la Feuille de calcul Variables3 il est tout a fait possible qu'à la suite du code logistique repris dans la colonne A de la Feuil Suivi que l'on retrouve du texte libre exemple : TXXX1 TEST
Il est également possible au sein d'une même cellule dans la Feuil de calcul Variables3, de retrouver plusieurs code logistiques exemple :
TXXX3 ESSAI
TTXX8 TEST

L'idée serait donc que la fonction soit capable d'isoler le ou les codes logistiques malgré la présence de texte autour (avant ou après).

Je sais que pour d'autres codes il faut utiliser * pour cela, mais ta fonction est bien au dessus de mon niveau

Encore merci pour ton aide.

Bonne journée

 

[job75]

Bonjour spike29,

Dans le code de la 1ère fonction remplacez If tablo(i, j) = critere Then par :

If tablo(i, j) = Like "*" & critere & "*" Then

Et enlevez d.CompareMode = vbTextCompare qui ne sert à rien.

A+

 

[spike29]

Bonjour Job75,

Désolé pour cette réponse tardive.
Top, ça fonctionne parfaitement. J'ai juste enlevé le = entre tablo(i,j) et Like

 If tablo(i, j) Like "*" & critere & "*" Then

Encore merci à toi pour cet énorme coup de pouce !

Je risque de reposter des questions dans le même genre avec des variantes prochainement car je travaille sur de la lecture et reporting d'informations contenues dans des fichiers.

Je vais auparavant essayer de m'approprier tes codes.

Bonne fin de journée