Recherche dates sur 2 colonnes

CorinneR

XLDnaute Nouveau
Bonjour,

J'essaie de faire une recherche de date (début et fin) sur 2 colonnes et comme je suis débutante, je rame depuis quelques jours !
Si les 2 dates sont dans la même colonne, ça fonctionne ci-dessous mon code mais je n'arrive à rien si la date de fin saisie dans textbox2 est sur la 2ème colonne.

pourriez-vous me mettre sur la piste svp ? si toutefois c'est possible.
merci

Sub CommandButton1_Click()

'déclaration des variables :
Dim DLig As Long
Dim Trouve As Range
Dim Trouve_2 As Range
Dim PlageDeRecherche As Range
Dim Date_debut As Date
Dim Date_fin As Date
Dim AdresseTrouvee As String
Dim mon_tab As Variant

'********* à adapter ***********
'affectation de valeurs aux variables :
'on cherche le mot "Trouve"
Date_debut = CDate(TextBox1)
Date_fin = CDate(TextBox2)

'dans la première colonne de la feuille active
Set PlageDeRecherche = Range("c5:f40")
'*******************************

'méthode find, ici on cherche la valeur exacte (LookAt:=xlWhole)
Set Trouve = PlageDeRecherche.Cells.Find(what:=CDate(Date_debut), LookAt:=xlWhole)
Trouve.Select
ActiveCell.Offset(0, 1).Value = "essai"
If Weekday(CDate(Date_debut), 2) > 5 Then
ActiveCell.Offset(0, 1).Value = ""
Else
ActiveCell.Offset(0, 1).Value = "essai"
End If

'traitement de l'erreur possible : Si on ne trouve rien :
If Trouve Is Nothing Then
'ici, traitement pour le cas où la valeur n'est pas trouvée
AdresseTrouvee = Valeur_Cherchee & " n'est pas présent dans " & PlageDeRecherche.Address
Else
'ici, traitement pour le cas où la valeur est trouvée
AdresseTrouvee = Trouve.Address
End If

ActiveCell.Offset(1, 0).Select

Do While ActiveCell.Value <> Date_fin + 1
If Weekday(ActiveCell.Value, 2) > 5 Then
ActiveCell.Offset(0, 1).Value = ""
Else
ActiveCell.Offset(0, 1) = "essai"
End If

ActiveCell.Offset(1, 0).Select

DLig = Range("C5").End(xlDown).Row + 1

If ActiveCell.Offset(1, 0).Row = DLig + 1 Then
MsgBox "adresse fin pas trouvée"
Exit Sub
End If

Loop

'MsgBox AdresseTrouvee
'vidage des variables
Set PlageDeRecherche = Nothing
Set Trouve = Nothing

End Sub
 

Theze

XLDnaute Occasionnel
Bonjour,

Partons du principe que tes dates son,t en colonne C et E de ta plage, j'ai épuré ton code pour plus de lisibilité, complète-le si ça marche chez toi.
Attention, la recherche de dates avec Find() est assez capricieuse et il peux être plus sûr de formater les valeur en Standard, faire la recherche sur des Long et non des Dates puis remettre le format date précédant :
Code:
Sub CommandButton1_Click()

    'déclaration des variables :
    Dim DLig As Long
    Dim Trouve As Range
    Dim Trouve_2 As Range
    Dim PlageDeRecherche As Range
    Dim Date_debut As Date
    Dim Date_fin As Date
    Dim AdresseTrouvee As String
    Dim mon_tab As Variant
   
    Date_debut = CDate(TextBox1)
    Date_fin = CDate(TextBox2)
   
    'dans la première colonne de la feuille active ??? ici ce sont 4 colonnes !!!
    Set PlageDeRecherche = Range("C5:F40")
    '*******************************
   
    'la recherche est faite sur la colonne C (1ère colonne de la plage)
    Set Trouve = PlageDeRecherche.Columns(1).Find(Date_debut, , , xlWhole)
   
    If Trouve Is Nothing Then MsgBox Date_debut & " n'est pas présente dans " & PlageDeRecherche.Columns(1).Address(0, 0): Exit Sub
   
    Trouve.Interior.ColorIndex = 3
   
    Trouve.Offset(0, 1).Value = IIf(Weekday(Trouve.Value, 2) > 5, "", "essai")
   
    'la recherche est faite sur la colonne E (3ème colonne de la plage)
    Set Trouve_2 = PlageDeRecherche.Columns(3).Find(Date_fin, , , xlWhole)
   
    If Trouve_2 Is Nothing Then MsgBox Date_fin & " n'est pas présente dans " & PlageDeRecherche.Columns(3).Address(0, 0): Exit Sub
    Trouve_2.Interior.ColorIndex = 3
   
    Trouve_2.Offset(0, 1).Value = IIf(Weekday(Trouve.Value, 2) > 5, "", "essai")
    '...
    '...
    '...
   
End Sub
 

CorinneR

XLDnaute Nouveau
Merci pour ta réponse.
J'ai essayé et une erreur apparait sur cette ligne "Trouve.Offset(0, 1).Value = IIf(Weekday(Trouve.Value, 2) > 5, "", "essai")"
Il me dit "erreur de compilation, attente fin d'instruction"
j'ai modifié le if mais ça ne fonctionne pas, il attends le Then et le end if ?
 

Theze

XLDnaute Occasionnel
Bonjour,

Il te faut séparer les plages :
Code:
Sub CommandButton1_Click()
   
    Dim DLig As Long
    Dim Trouve As Range
    Dim Trouve_2 As Range
    Dim Plg1 As Range
    Dim Plg2 As Range
    Dim Date_debut As Date
    Dim Date_fin As Date
    Dim AdresseTrouvee As String
    Dim mon_tab As Variant
      
    Date_debut = CDate(TextBox1)
    Date_fin = CDate(TextBox2)
   
        'dans la plage (C:F)
    Set Plg1 = Range("C5:C40")
    Set Plg2 = Range("F5:F40")
   
    Set Trouve = Plg1.Cells.Find(Date_debut, , , xlWhole)
   
    If Trouve Is Nothing Then MsgBox Date_debut & " n'est pas présente dans " & Plg1.Columns(1).Address(0, 0): Exit Sub
  
    Trouve.Interior.ColorIndex = 3
    Trouve.Offset(0, 1).Value = IIf(Weekday(Trouve.Value, 2) > 5, "", "essai")
   
    'la recherche est faite sur la colonne E (3ème colonne de la plage)
    Set Trouve_2 = Plg2.Find(Date_fin, , , xlWhole)
  
    If Trouve_2 Is Nothing Then MsgBox Date_fin & " n'est pas présente dans " & Plg1.Columns(3).Address(0, 0): Exit Sub
   
    Trouve_2.Interior.ColorIndex = 3
    Trouve_2.Offset(0, 1).Value = IIf(Weekday(Trouve.Value, 2) > 5, "", "essai")
   
End Sub
 

Discussions similaires

Réponses
49
Affichages
1 K

Statistiques des forums

Discussions
315 098
Messages
2 116 190
Membres
112 679
dernier inscrit
Yupanki