recherche plusieur date une seul cellule

ILOVEUBB

ILOVEUBB

XLDnaute Occasionnel
bonjour !
voila je suis devant une impasse , avec l'aide du forum et l'orientation des membres j'ai pu réaliser ce code qui me permet de faire apparaitre un message 2 jour avant , et il fonctionnent très bien seulement quand il ya une seul date dans la cellule mais pas quand il ya plusieurs date dans la cellule séparant avec ( ; ) .
je ne c'est pas comment procéder !!!!!



code:

Sub thedate()
Dim TheDate As String, Index As Variant
Dim T As Variant, MyDate As String

TheDate = Format((Date + 2), "dd/mm/yyyy")

T = Range("Feuil2!H1:H65000")

Index = Application.Match(TheDate, T, 0)

If IsError(Index) Then
MsgBox "Résultat négatif. Rien trouvé.", vbOKOnly + vbInformation, "Résultat"
Else

MsgBox "La Prochaine Date : " & TheDate & " existe. Elle est représentée par " & _
"l'item " & Index & " du tableau." & " N° :" & Cells(Index, 24), vbInformation + vbOKOnly, "Résultat"
End If
Erase T
End Sub
 
Trier par date Trier par votes
job75

job75

XLDnaute Barbatruc
Re : recherche plusieur date une seul cellule

Bonjour ILOVEUBB, le forum,

Code: 
Sub TheDate()
Dim dat As Date, t, i&, s, j%
dat = Date + 2
With Feuil2 'CodeName de la feuille
  t = .Range("A1:X" & .Range("H" & Rows.Count).End(xlUp).Row)
End With
For i = 1 To UBound(t)
  s = Split(t(i, 8), ";")
  For j = 0 To UBound(s)
    If IsDate(s(j)) Then
      If CDate(s(j)) = dat Then
        MsgBox "La Prochaine date : " & dat & " existe. Elle est représentée par " & _
          "l'item " & i & " du tableau." & " N° : " & t(i, 24), 64, "Résultat"
        Exit Sub
      End If
    End If
  Next
Next
MsgBox "Résultat négatif. Rien trouvé.", 64, "Résultat"
End Sub
Dans chaque cellule en colonne H il peut y avoir une vraie date ou des dates sous forme de texte séparées par des points-virgules.

A+
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : recherche plusieur date une seul cellule

Re,

Si toutes les dates sont au format jj/mm/aaaa on peut utiliser la méthode Find :

Code: 
Sub TheDate1()
Dim dat As String, c As Range
dat = Date + 2
With Feuil2 'CodeName de la feuille
  Set c = .[H:H].Find(dat, , xlValues, xlPart)
  If c Is Nothing Then Set c = .[H:H].Find(CDate(dat))
  If Not c Is Nothing Then _
    MsgBox "La Prochaine date : " & dat & " existe. Elle est représentée par " & _
      "l'item " & c.Row & " du tableau." & " N° : " & c(1, 17), 64, "Résultat": Exit Sub
End With
MsgBox "Résultat négatif. Rien trouvé.", 64, "Résultat"
End Sub
A+
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : recherche plusieur date une seul cellule

Re,

Avec la macro du post #3, s'il y a plusieurs dates identiques, la date trouvée peut ne pas être la 1ère.

Donc si l'on veut absolument la 1ère, il faut compliquer un peu :

Code: 
Sub TheDate2()
Dim dat As String, i&, c As Range
dat = Date + 2
i = 9 ^ 9
With Feuil2 'CodeName de la feuille
  Set c = .[H:H].Find(dat, , xlValues, xlPart)
  If Not c Is Nothing Then i = c.Row
  Set c = .[H:H].Find(CDate(dat))
  If Not c Is Nothing Then If c.Row < i Then i = c.Row
  If i < 9 ^ 9 Then _
    MsgBox "La Prochaine date : " & dat & " existe. Elle est représentée par " & _
    "l'item " & i & " du tableau." & " N° : " & .Cells(i, 24), 64, "Résultat": Exit Sub
End With
MsgBox "Résultat négatif. Rien trouvé.", 64, "Résultat"
End Sub
A+
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : recherche plusieur date une seul cellule

Re,

Dernière solution avec la fonction Match :

Code: 
Sub TheDate3()
Dim dat As Long, t As String, i As Variant, j As Variant
dat = Date + 2
t = Format(dat, "dd/mm/yyyy") 'format à adapter aux dates "textes"
With Feuil2 'CodeName de la feuille
  i = Application.Match("*" & t & "*", .[H:H], 0)
  If IsError(i) Then i = 9 ^ 9
  j = Application.Match(dat, .[H:H], 0)
  If IsNumeric(j) Then If j < i Then i = j
  If i < 9 ^ 9 Then _
    MsgBox "La Prochaine date : " & t & " existe. Elle est représentée par " & _
    "l'item " & i & " du tableau." & " N° : " & .Cells(i, 24), 64, "Résultat": Exit Sub
End With
MsgBox "Résultat négatif. Rien trouvé.", 64, "Résultat"
End Sub
On a ainsi fait le tour de la question.

Bien noter cependant que la 1ère solution (post #2) paraît la meilleure car elle ne dépend pas du format des dates.

Et même sur un très grand tableau elle est très rapide (moins que les autres évidemment).

Edit : corrigé, j'avais mis dat au lieu de t dans la MsgBox.

A+
 
Dernière édition:
Vote positif 0 Vote négatif
ILOVEUBB

ILOVEUBB

XLDnaute Occasionnel
Re : recherche plusieur date une seul cellule

salut job75
désoler de me retournée en ver toi , mais...je suis bloquer encor
tes programme fonctionnent a merveille mais après quelque temps je suis confronter a deux problème , le 1ers dans la même date il peut y avoir plusieurs n° et je ne c'est pas comment les afficher tous dans la msgbox ;
2eme problème la date trouver dans la colonne H s'affiche dans la msgbox sous forme de numéro en quelque sort il me la converti je ne c'est pas pourquoi pourtant la première fois le programme tourné très bien
je ne c'est pas quoi faire , peut tu m’orienter
merci
 
Vote positif 0 Vote négatif
ILOVEUBB

ILOVEUBB

XLDnaute Occasionnel
Re : recherche plusieur date une seul cellule

salut job75

voila un ficher joint !
désoler j'ai corriger le fichier
 

Pièces jointes

  • Classeur1.xlsm
    15.9 KB · Affichages: 41
  • Classeur1.xlsm
    15.9 KB · Affichages: 48
  • Classeur1.xlsm
    15.9 KB · Affichages: 50
  • Classeur2.xlsm
    21.8 KB · Affichages: 43
  • Classeur2.xlsm
    21.8 KB · Affichages: 46
  • Classeur2.xlsm
    21.8 KB · Affichages: 41
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : recherche plusieur date une seul cellule

Re,

Vous avez fait 2 erreurs :

- il s'agit de Feuil1

- vous n'avez pas vu l'Edit de mon post #6 qui corrigeait la macro.

Code: 
'--------------
   With Feuil1
     '--------------
     MsgBox "la Prochaine date : " & t & " exist. elle est representée par " & _
    "la litem  " & i & " du tableau. " & "Sous le N°: " & .Cells(i, 24) & "   , .Lieu :" & .Cells(i, 25), 64, "Résultat": Exit Sub
Et concernant votre 1er problème, que voulez-vous obtenir exactement ??

Bonne nuit, je vais me coucher.
 
Vote positif 0 Vote négatif
ILOVEUBB

ILOVEUBB

XLDnaute Occasionnel
Re : recherche plusieur date une seul cellule

désoler job75 !!!
merci pour votre aide
. pour le problème je afficher dans la msgbox tous les date trouvez (date+2) car la (date +2 ) peut se répéter sur plusieurs cellule , mais le N° change
pourquoi il me convertie la date sous form de exp : 41792
 
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : recherche plusieur date une seul cellule

Bonjour ILOVEUBB,

Il y a une 3ème erreur : If i < 9 ^ 9 Then _

La bonne macro :

Code: 
Sub TheDate()
Dim dat As Long, t As String, i As Variant, j As Variant
   
dat = Date + 2
t = Format(dat, "dd/mm/yyyy")
   
With Feuil1
  i = Application.Match("*" & t & "*", .[H:H], 0)
  If IsError(i) Then i = 9 ^ 9
  j = Application.Match(dat, .[H:H], 0)
  If IsNumeric(j) Then If j < i Then i = j
  If i < 9 ^ 9 Then
    Beep 2000, 500
    Beep 2000, 500
    Beep 2000, 500
    MsgBox "la Prochaine date : " & t & " exist. elle est representée par " & _
    "la litem  " & i & " du tableau. " & "Sous le N°: " & .Cells(i, 24) & "   , .Lieu :" & .Cells(i, 25), 64, "Résultat"
    Exit Sub
  End If
End With
MsgBox "résultat négatif. rien trouvé.", 64, "Résultat"

End Sub
Si au lieu de rechercher la 1ère date vous les voulez toutes il faut utiliser la méthode du post #2.

Je vous montre ça dans le post suivant.

A+
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : recherche plusieur date une seul cellule

Re,

Votre fichier complété avec plusieurs 02/06/2014 et cette macro :

Code: 
Sub TheDate()
Dim dat As Date, t, i&, s, j%, m1$, m2$
dat = Date + 2
With Feuil1 'CodeName de la feuille
  t = .Range("A1:X" & .Range("H" & Rows.Count).End(xlUp).Row)
End With
For i = 1 To UBound(t)
  s = Split(t(i, 8), ";")
  For j = 0 To UBound(s)
    If IsDate(s(j)) Then
      If CDate(s(j)) = dat Then
        m1 = m1 & vbLf & "- " & i
        m2 = m2 & vbLf & "- " & t(i, 24)
      End If
    End If
  Next
Next
MsgBox IIf(m1 <> "", "La Prochaine date : " & dat & " existe. Elle est représentée par " & _
          "les items :" & m1 & vbLf & " du tableau." & " N° : " & m2, _
          "Résultat négatif. Rien trouvé."), 64, "Résultat"
End Sub
A+
 

Pièces jointes

  • Classeur(1).xlsm
    21.3 KB · Affichages: 41
  • Classeur(1).xlsm
    21.3 KB · Affichages: 48
  • Classeur(1).xlsm
    21.3 KB · Affichages: 33
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : recherche plusieur date une seul cellule

Re,

Une autre présentation des résultats avec des tabulations :

Code: 
Sub TheDate()
Dim dat As Date, t, i&, s, j%, m$
dat = Date + 2
With Feuil1 'CodeName de la feuille
  t = .Range("A1:Y" & .Range("H" & Rows.Count).End(xlUp).Row)
End With
For i = 1 To UBound(t)
  s = Split(t(i, 8), ";")
  For j = 0 To UBound(s)
    If IsDate(s(j)) Then
      If CDate(s(j)) = dat Then
        m = m & vbLf & i & vbTab & t(i, 24) & vbTab & _
          IIf(Len(t(i, 24)) < 8, vbTab, "") & t(i, 25)
      End If
    End If
  Next
Next
MsgBox IIf(m <> "", "La Prochaine date : " & dat & " existe." & _
       vbLf & vbLf & "Items" & vbTab & "N°" & vbTab & vbTab & "Lieu" & m, _
       "Résultat négatif. Rien trouvé."), 64, "Résultat"
End Sub
Fichier (2).

A+
 

Pièces jointes

  • Classeur(2).xlsm
    21.4 KB · Affichages: 29
  • Classeur(2).xlsm
    21.4 KB · Affichages: 30
  • Classeur(2).xlsm
    21.4 KB · Affichages: 37
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : recherche plusieur date une seul cellule

Re,

Pour qu'il n'y ait pas de problème avec les tabulations il vaut mieux donner aux N° la même longueur :

Code: 
Sub TheDate()
Dim dat As Date, t, i&, s, j%, m$
dat = Date + 2
With Feuil1 'CodeName de la feuille
  t = .Range("A1:Y" & .Range("H" & Rows.Count).End(xlUp).Row)
End With
For i = 1 To UBound(t)
  s = Split(t(i, 8), ";")
  For j = 0 To UBound(s)
    If IsDate(s(j)) Then
      If CDate(s(j)) = dat Then
        m = m & vbLf & i & vbTab & _
          Right("000000000" & t(i, 24), 9) & vbTab & t(i, 25)
      End If
    End If
  Next
Next
Beep 2000, 500
Beep 2000, 500
Beep 2000, 500
MsgBox IIf(m <> "", "La Prochaine date : " & dat & " existe." & _
       vbLf & vbLf & "Items" & vbTab & "N°" & vbTab & vbTab & "Lieu" & m, _
       "Résultat négatif. Rien trouvé."), 64, "Résultat"
End Sub
Fichier (3).

A+
 

Pièces jointes

  • Classeur(3).xlsm
    21.7 KB · Affichages: 41
  • Classeur(3).xlsm
    21.7 KB · Affichages: 38
  • Classeur(3).xlsm
    21.7 KB · Affichages: 46
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

patricktoulon
  • Résolu(e)
XL 2013 prise de tête avec une variable static
Réponses
3
Affichages
220
patricktoulon
patricktoulon
G
  • Question
Microsoft 365 Saut de ligne dans une cellule
Réponses
3
Affichages
123
GClaire
G
Usine à gaz
  • Résolu(e)
Microsoft 365 lister des fichiers
2
Réponses
19
Affichages
2 K
Usine à gaz
Usine à gaz
Z
  • Question
XL 2021 VBA Prélèvement d'une donnée si une valeur recherchée est identique
Réponses
3
Affichages
177
ZiM
Z
T
  • Question
XL pour MAC Recherche date
Réponses
5
Affichages
1 K
tdenis
T
Etoto
  • Résolu(e)
Microsoft 365 Code VBA qui renvoie une matrice à partir d'un liste à cocher au lieu d'une cellule
Réponses
5
Affichages
565
yal
Y
E
  • Question
Microsoft 365 Ecrire une date en fonction d'une recherche (vba)
Réponses
2
Affichages
1 K
Eisu
E
C
  • Résolu(e)
Microsoft 365 SI remplissage cellule (MFC) ALORS transposer la réponse dans une colonne
Réponses
3
Affichages
1 K
Chaine
C
S
  • Résolu(e)
Autres VBA pour copier une cellule à gauche de la cellule sélectionnée
Réponses
1
Affichages
1 K
sg394
S
GADENSEB
  • Question
Microsoft 365 Simplification de code
Réponses
1
Affichages
1 K
GADENSEB
GADENSEB

Membres actuellement en ligne

2 membres et 41 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 084
Messages
2 085 194
Membres
102 814
dernier inscrit
JLGalley