Trouver la 2e date la plus récente, modification macro
Bonjour à tous,
J'aurai besoin d'aide afin de modifier une macro qu'une personne du forum m'avait fait. Ce programme me permet de récupérer une valeur dans une base de donnée en prenant celle qui est la plus récente.
J'aurai besoin de prendre la 2e date la plus récente et non plus la 1ère.
J'ai essayé toutes les modifications auquel j'ai pensé mais sans succès.
Merci d'avance pour votre aide
'Programme permettant de chercher les valeurs de toutes les TextBox grisées
Sub Recherche()
Dim Nblg As Long, Ligne As Long
Dim Cel As Range
Dim Depart As String
Dim Ladate As Date
Dim Colonne As Integer
'Permet de trouver la dernière valeur
Me.TextBox2 = ""
With Sheets("Feuil1") ' Page de travail
Nblg = .Range("A" & Rows.Count).End(xlUp).Row ' Nombre de ligne dans la base
.Columns(1).Insert ' On insère une colonne pour la recherche
With .Range("A2:A" & Nblg) ' Dans une colonne en dehors de la base
.Formula = "=B2&C2&D2&F2" ' On concatène
.Value = .Value ' Juste le résultat
End With
' Recherche dans cette colonne la chaine composée de : TextBox7 + ComboBox1 + ComboBox2+ TextBox8
Set Cel = .Columns("A").Find(what:=TextBox7 & ComboBox2 & ComboBox3 & TextBox8, LookIn:=xlValues, lookat:=xlWhole)
'Relève la valeur voulue
If Not Cel Is Nothing Then
Depart = Cel.Address
Do
'Permet de prendre la valeur à la date la plus récente
If Cel.Offset(0, 6) > Ladate Then
Ladate = CDate(Cel.Offset(0, 6))
Ligne = Cel.Row
End If
Set Cel = .Columns("A").FindNext(Cel)
Loop While Depart <> Cel.Address
Me.Label7.Visible = False
' Chaine trouvée
Me.TextBox2 = .Range("I" & Ligne) ' On note la valeur relevée
Else
' Sinon on affiche le message
Me.Label7.Visible = True
End IfUchi a écrit :Bonjour à tous,
J'aurai besoin d'aide afin de modifier une macro qu'une personne du forum m'avait fait. Ce programme me permet de récupérer une valeur dans une base de donnée en prenant celle qui est la plus récente.
J'aurai besoin de prendre la 2e date la plus récente et non plus la 1ère.
J'ai essayé toutes les modifications auquel j'ai pensé mais sans succès.
Merci d'avance pour votre aide
bonjour,
proposition de modifications dans le code, à tester
'Programme permettant de chercher les valeurs de toutes les TextBox grisées
Sub Recherche()
Dim Nblg As Long, Ligne As Long,LigneP as long
Dim Cel As Range
Dim Depart As String
Dim Ladate As Date,LadateP as date
Dim Colonne As Integer
'Permet de trouver la dernière valeur
Me.TextBox2 = ""
With Sheets("Feuil1") ' Page de travail
Nblg = .Range("A" & Rows.Count).End(xlUp).Row ' Nombre de ligne dans la base
.Columns(1).Insert ' On insère une colonne pour la recherche
With .Range("A2:A" & Nblg) ' Dans une colonne en dehors de la base
.Formula = "=B2&C2&D2&F2" ' On concatène
.Value = .Value ' Juste le résultat
End With
' Recherche dans cette colonne la chaine composée de : TextBox7 + ComboBox1 + ComboBox2+ TextBox8
Set Cel = .Columns("A").Find(what:=TextBox7 & ComboBox2 & ComboBox3 & TextBox8, LookIn:=xlValues, lookat:=xlWhole)
'Relève le taux de fer
If Not Cel Is Nothing Then
Depart = Cel.Address
Do
'Permet de prendre la valeur à la date la plus récente
If Cel.Offset(0, 6) > Ladate Then
ladate=ladateP
ligne=ligneP
LadateP = CDate(Cel.Offset(0, 6))
LigneP = Cel.Row
End If
Set Cel = .Columns("A").FindNext(Cel)
Loop While Depart <> Cel.Address
Me.Label7.Visible = False
' Chaine trouvée
Me.TextBox2 = .Range("I" & Ligne) ' On note la valeur relevée
Else
' Sinon on affiche le message
Me.Label7.Visible = True
End IfCela ne fonctionne pas, il m'affiche directement le label7. J'ai oublié de préciser également, je vais devoir rechercher pour 3 textbox différentes la 1ère, 2e et 3e valeur la plus récente. Je ne sais pas si cela change quelque chose.
Merci pour l'aide déjà apportée.
Bonjour,
si le label7 est directement affiché, je ne pense pas que ce soit dû aux modifications que j'ai faites, mais bien au fait que la valeur recherchée n'est pas trouvée. Mais comme je n'ai pas la possibilité de tester ...
pour l'autre remarque, le code devra être adapté.
Bonjour,
Je reviens vers vous seulement maintenant, j’ai été très occupé ces derniers temps.
J’ai essayé de retravailler sur mon problème mais sans succès. J’ai donc refait un fichier très light de ce qu’il me faut. Cela m’aiderait bien si vous pouviez me sortir de cette impasse.
Pour faire fonctionner le programme, il suffit de rentrer la valeur « 1001 » dans la case N°, de choisir « type 2 » dans la liste déroulante type client, et de choisir le numéro « 8 » dans la liste déroulante rayon. A ce moment le numéro « 268" va apparaitre automatiquement (trouvé dans la feuille 3).
Lorsque vous cliquez sur le bouton valider il fait alors directement la recherche de la dernière action effectuée précédemment en fonction des valeurs rentrées précédemment. J’ai donc besoin qu’il trouve la deuxième action la plus récente à effectuer dans la liste de la feuille 2.
Merci d’avance pour votre aide.
Bonjour,
Personne pour m'aider?
Bonjour,
Toujours personne?
Bonjour,
J'ai finalement le code.
Je le poste sur le forum afin qu'il puisse servir à tout le monde:
Private Sub CommandButton1_Click()
Dim Nblg As Long, Ligne As Long
Dim Cel As Range
Dim Depart As String
Dim Ladate As Date
Dim Colonne As Integer
Application.ScreenUpdating = False
With Sheets("Feuil2") ' Page de travail
Nblg = .Range("A" & Rows.Count).End(xlUp).Row ' Nombre de ligne dans la base
.Columns(1).Insert ' On insère une colonne pour la recherche
With .Range("A2:A" & Nblg) ' Dans une colonne en dehors de la base
.Formula = "=B2&C2&D2&E2" ' On concatène
.Value = .Value ' Juste le résultat
End With
'Date la plus récente
' Recherche dans cette colonne la chaine composée de : TextBox7 + ComboBox1 + ComboBox2+ TextBox8
Set Cel = .Columns("A").Find(what:=TextBox7 & ComboBox3 & ComboBox2 & TextBox8, LookIn:=xlValues, lookat:=xlWhole)
If Not Cel Is Nothing Then
Depart = Cel.Address
Do
'Permet de prendre la valeur à la date la plus récente
If Cel.Offset(0, 5) > Ladate Then
Ladate = CDate(Cel.Offset(0, 5))
Ligne = Cel.Row
End If
Set Cel = .Columns("A").FindNext(Cel)
Loop While Depart <> Cel.Address
Me.Label16.Visible = False
' Chaine trouvée
Me.TextBox9 = .Range("G" & Ligne)
.Range("A" & Ligne) = "" ' On élimine cette réponse
Else
' Sinon on affiche le message
Me.Label16.Visible = True
End If
' Deuxième date la plus récente
Ladate = 0
' Recherche dans cette colonne la chaine composée de : TextBox7 + ComboBox1 + ComboBox2+ TextBox8
Set Cel = .Columns("A").Find(what:=TextBox7 & ComboBox3 & ComboBox2 & TextBox8, LookIn:=xlValues, lookat:=xlWhole)
If Not Cel Is Nothing Then
Depart = Cel.Address
Do
'Permet de prendre la valeur à la date la plus récente
If Cel.Offset(0, 5) > Ladate Then
Ladate = CDate(Cel.Offset(0, 5))
Ligne = Cel.Row
End If
Set Cel = .Columns("A").FindNext(Cel)
Loop While Depart <> Cel.Address
Me.Label26.Visible = False
' Chaine trouvée
Me.TextBox15 = .Range("G" & Ligne)
Else
' Sinon on affiche le message
Me.Label26.Visible = True
End If
' On supprime la colonne de recherche
.Columns("A").Delete
End With
End SubMerci à ceux qui auront pris le temps de regarder mon programme.