Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

spike29

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

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

Pièces jointes

  • TESTVBA1.xlsm
    84 KB · Affichages: 11
Solution
Bonjour spike29,

Dans le code de la 1ère fonction remplacez If tablo(i, j) = critere Then par :
VB:
If tablo(i, j) = Like "*" & critere & "*" Then
Et enlevez d.CompareMode = vbTextCompare qui ne sert à rien.

A+

job75

XLDnaute Barbatruc
Bonjour spike29,

Dans la feuille "Suivi" formule en J10 :
Code:
=Recherche_dates(A10;Variables3!B:K)
Formule en K10 :
Code:
=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 :
VB:
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+
 

Pièces jointes

  • TESTVBA(1).xlsm
    90.3 KB · Affichages: 10

spike29

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

XLDnaute Barbatruc
Bonjour spike29,

Dans le code de la 1ère fonction remplacez If tablo(i, j) = critere Then par :
VB:
If tablo(i, j) = Like "*" & critere & "*" Then
Et enlevez d.CompareMode = vbTextCompare qui ne sert à rien.

A+
 

spike29

XLDnaute Occasionnel
Bonjour Job75,

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

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

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…