Comment sélectionner par VBA la date du jour dans la colonne C de ma feuille ?
Sub DateDuJour()
'Denis Michon MPFE 2008
Dim No_Ligne As Variant
With Worksheets("Feuil1") 'nom feuille à adapter
.Activate
No_Ligne = Application.Match(CLng(Date), .Range("C3:C50"), 0)
If Not IsError(No_Ligne) Then
.Range("C" & No_Ligne).Select
Else
Err.Clear
MsgBox "pas trouvé"
End If
End With
End Sub
'Denis Michon MPFE 2008
Dim No_Ligne As Variant
With Worksheets("Feuil1") 'nom feuille à adapter
.Activate
No_Ligne = Application.Match(CLng(Date), .Range("C3:C50"), 0)
If Not IsError(No_Ligne) Then
.Range("C" & No_Ligne).Select
Else
Err.Clear
MsgBox "pas trouvé"
End If
End With
End Sub
Denis Michon,
Ajouté ou modifié le 05/01/2008 (N°1954)
Ajouté ou modifié le 05/01/2008 (N°1954)
J'ai entré des dates en omettant les années. Excel les a complétées par l'année en cours.
Comment trier ces dates maintenant sans tenir compte de l'année ?
Tu peux aussi voir la solution "trier des dates d'anniversaires".
Et voici quatre autres solutions !
Sub TrierSansAnnées() 'fs
Dim Sel As Range, NbLi&
On Error Resume Next
Set Sel = Application.InputBox("Plage à trier :", Type:=8)
If Err <> 0 Then Exit Sub
If Sel.Columns.Count <> 2 Then Exit Sub
NbLi = Sel.Rows.Count
Application.ScreenUpdating = False
Sel.Columns("B:B").Insert xlToRight
Sel.Range("B1:B" & NbLi).FormulaR1C1 =
"=RC[-1]-DATE(YEAR(RC[-1]),1,0)"
Sel.Range("A1:C" & NbLi).Sort Sel.Range("B1")
Sel.Columns("B:B").Delete
End Sub
Sub TriDates() 'GeeDee
Application.ScreenUpdating = False
'----determine le nombre de dates dans la liste
nblignes = Cells(1, 1).CurrentRegion.Rows.Count
'----insere une colonne en position 3
Range("C1").Select
Selection.EntireColumn.Insert
'----une formule avec le mois et le jour
Range("C1").Select
ActiveCell.FormulaR1C1 = "=TEXT(RC[-2],""mm jj"")"
'----recopie sur la plage concernée
Range(Cells(1, 3), Cells(nblignes, 3)).Select
Selection.FillDown
'-----trie par date anniversaire
Range("C1").Select
Selection.Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'-----supprime la colonne inserée précédement
Range("C1").Select
Selection.EntireColumn.Delete
'-----rafraichit l'affichage
Application.ScreenUpdating = True
End Sub
***************************
La région à trier est nommée (insertion/nom/définir) Zn. Elle peut ne contenir que la colonne
des dates, ici en colonne A, ou la colonne des dates plus d'autres à trier en même temps:
Sub datAnn() 'ChrisV
Application.ScreenUpdating = False
For Each c In Range("A2:A100")
If Year(c.Value) = 1899 Or (Year(c.Value) = 1900 _
And Month(c.Value) < 3) Then
c.Value = DateValue(Day(c.Value + 1) & "/" _
& Month(c.Value + 1) & "/" & 1904)
Else
c.Value = DateValue(Day(c.Value) & "/" _
& Month(c.Value) & "/" & 1904)
End If
c.Value = c.Value
c.NumberFormat = "dd-mmm"
Next c
Range("Zn").Sort Key1:=Range("A2"), Order1:=xlAscending
End Sub
Cette première macro fonctionne si on a des cellules libres (à droite) pour
toutes les LIGNES de la 'CurrentRegion' de la 'ActiveCell'
Sub TrierParMoisJour() 'Daniel Maher (impec!)
Dim AllRegion As Range, LastColumn As Range
Dim nCol As Long
nCol = ActiveCell.CurrentRegion.Columns.Count
' Agrandit la plage CurrentRegion de 1 colonne
Set AllRegion = ActiveCell.CurrentRegion.Resize(, nCol + 1)
Set LastColumn = AllRegion.Offset(0, nCol).Resize(, 1)
LastColumn.FormulaR1C1 = "=MONTH(RC[-" & nCol &
"])*32+DAY(RC[-" & nCol & "])"
AllRegion.Sort Key1:=LastColumn, Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
LastColumn.ClearContents ' Détruit les entrées de la dernière colonne
End Sub
Et voici quatre autres solutions !
Sub TrierSansAnnées() 'fs
Dim Sel As Range, NbLi&
On Error Resume Next
Set Sel = Application.InputBox("Plage à trier :", Type:=8)
If Err <> 0 Then Exit Sub
If Sel.Columns.Count <> 2 Then Exit Sub
NbLi = Sel.Rows.Count
Application.ScreenUpdating = False
Sel.Columns("B:B").Insert xlToRight
Sel.Range("B1:B" & NbLi).FormulaR1C1 =
"=RC[-1]-DATE(YEAR(RC[-1]),1,0)"
Sel.Range("A1:C" & NbLi).Sort Sel.Range("B1")
Sel.Columns("B:B").Delete
End Sub
Sub TriDates() 'GeeDee
Application.ScreenUpdating = False
'----determine le nombre de dates dans la liste
nblignes = Cells(1, 1).CurrentRegion.Rows.Count
'----insere une colonne en position 3
Range("C1").Select
Selection.EntireColumn.Insert
'----une formule avec le mois et le jour
Range("C1").Select
ActiveCell.FormulaR1C1 = "=TEXT(RC[-2],""mm jj"")"
'----recopie sur la plage concernée
Range(Cells(1, 3), Cells(nblignes, 3)).Select
Selection.FillDown
'-----trie par date anniversaire
Range("C1").Select
Selection.Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'-----supprime la colonne inserée précédement
Range("C1").Select
Selection.EntireColumn.Delete
'-----rafraichit l'affichage
Application.ScreenUpdating = True
End Sub
***************************
La région à trier est nommée (insertion/nom/définir) Zn. Elle peut ne contenir que la colonne
des dates, ici en colonne A, ou la colonne des dates plus d'autres à trier en même temps:
Sub datAnn() 'ChrisV
Application.ScreenUpdating = False
For Each c In Range("A2:A100")
If Year(c.Value) = 1899 Or (Year(c.Value) = 1900 _
And Month(c.Value) < 3) Then
c.Value = DateValue(Day(c.Value + 1) & "/" _
& Month(c.Value + 1) & "/" & 1904)
Else
c.Value = DateValue(Day(c.Value) & "/" _
& Month(c.Value) & "/" & 1904)
End If
c.Value = c.Value
c.NumberFormat = "dd-mmm"
Next c
Range("Zn").Sort Key1:=Range("A2"), Order1:=xlAscending
End Sub
Cette première macro fonctionne si on a des cellules libres (à droite) pour
toutes les LIGNES de la 'CurrentRegion' de la 'ActiveCell'
Sub TrierParMoisJour() 'Daniel Maher (impec!)
Dim AllRegion As Range, LastColumn As Range
Dim nCol As Long
nCol = ActiveCell.CurrentRegion.Columns.Count
' Agrandit la plage CurrentRegion de 1 colonne
Set AllRegion = ActiveCell.CurrentRegion.Resize(, nCol + 1)
Set LastColumn = AllRegion.Offset(0, nCol).Resize(, 1)
LastColumn.FormulaR1C1 = "=MONTH(RC[-" & nCol &
"])*32+DAY(RC[-" & nCol & "])"
AllRegion.Sort Key1:=LastColumn, Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
LastColumn.ClearContents ' Détruit les entrées de la dernière colonne
End Sub
Frédéric Sigonneau, GeeDee, ChrisV, Daniel Maher, (N°611)
J'ai une liste de dates de naissances. Je voudrais les trier par dates d'anniversaire
(jours/mois) tout en conservant les années.
Colle ceci dans un module standard de ton classeur et lance la procédure
TriDates. Il te faudra rentrer la référence de la plage de cellules à trier. C'est à dire celle
contenant la colonne des dates et celle des noms.
Cette macro crée un tableau (array) qui est trié par un tri à bulles,
ce qui évite d'utiliser, même temporairement, une colonne de la feuille de
calcul.
Sub TriDates()
Dim Sel As Range
On Error Resume Next
Set Sel = Application.InputBox( _
"Plage à trier :", Type:=8)
If Err <> 0 Then
Exit Sub
Else
TriDatesAnniversaire Sel, 1
End If
End Sub
******************
Private Sub TriDatesAnniversaire(Plage As Range, ColonneDate As Integer)
Dim Tableau, Compteur As Long
Dim Colonne As Long
Colonne = Plage.Columns.Count + 1
Tableau = Plage.Value2
ReDim Preserve Tableau(1 To Plage.Rows.Count, 1 To Plage.Columns.Count + 1)
For Compteur = 1 To UBound(Tableau)
Tableau(Compteur, Colonne) = _
Month(Tableau(Compteur, ColonneDate)) * 32 + _
Day(Tableau(Compteur, ColonneDate))
Next Compteur
Tableau = TriABulles(Tableau)
ReDim Preserve Tableau(1 To UBound(Tableau), 1 To UBound(Tableau, 2) - 1)
Plage.Value = Tableau
End Sub
******************
Function TriABulles(Tableau)
Dim Compteur As Long, Compteur1 As Long
Dim CompteurColonne As Long
Dim ValTemp As Variant
For Compteur = 1 To UBound(Tableau)
For Compteur1 = Compteur + 1 To UBound(Tableau)
For CompteurColonne = 1 To UBound(Tableau, 2)
If Tableau(Compteur, UBound(Tableau, 2)) > _
Tableau(Compteur1, UBound(Tableau, 2)) Then
ValTemp = Tableau(Compteur, CompteurColonne)
Tableau(Compteur, CompteurColonne) = _
Tableau(Compteur1, CompteurColonne)
Tableau(Compteur1, CompteurColonne) = ValTemp
End If
Next CompteurColonne
Next Compteur1
Next Compteur
TriABulles = Tableau
End Function
TriDates. Il te faudra rentrer la référence de la plage de cellules à trier. C'est à dire celle
contenant la colonne des dates et celle des noms.
Cette macro crée un tableau (array) qui est trié par un tri à bulles,
ce qui évite d'utiliser, même temporairement, une colonne de la feuille de
calcul.
Sub TriDates()
Dim Sel As Range
On Error Resume Next
Set Sel = Application.InputBox( _
"Plage à trier :", Type:=8)
If Err <> 0 Then
Exit Sub
Else
TriDatesAnniversaire Sel, 1
End If
End Sub
******************
Private Sub TriDatesAnniversaire(Plage As Range, ColonneDate As Integer)
Dim Tableau, Compteur As Long
Dim Colonne As Long
Colonne = Plage.Columns.Count + 1
Tableau = Plage.Value2
ReDim Preserve Tableau(1 To Plage.Rows.Count, 1 To Plage.Columns.Count + 1)
For Compteur = 1 To UBound(Tableau)
Tableau(Compteur, Colonne) = _
Month(Tableau(Compteur, ColonneDate)) * 32 + _
Day(Tableau(Compteur, ColonneDate))
Next Compteur
Tableau = TriABulles(Tableau)
ReDim Preserve Tableau(1 To UBound(Tableau), 1 To UBound(Tableau, 2) - 1)
Plage.Value = Tableau
End Sub
******************
Function TriABulles(Tableau)
Dim Compteur As Long, Compteur1 As Long
Dim CompteurColonne As Long
Dim ValTemp As Variant
For Compteur = 1 To UBound(Tableau)
For Compteur1 = Compteur + 1 To UBound(Tableau)
For CompteurColonne = 1 To UBound(Tableau, 2)
If Tableau(Compteur, UBound(Tableau, 2)) > _
Tableau(Compteur1, UBound(Tableau, 2)) Then
ValTemp = Tableau(Compteur, CompteurColonne)
Tableau(Compteur, CompteurColonne) = _
Tableau(Compteur1, CompteurColonne)
Tableau(Compteur1, CompteurColonne) = ValTemp
End If
Next CompteurColonne
Next Compteur1
Next Compteur
TriABulles = Tableau
End Function
Pierre Fauconnier, Daniel Maher, Frédéric Sigonneau, (N°610)
Je souhaite remplacer une date par une autre. Quand je fais Editer - Rechercher/Remplacer, la
fonction ne marche pas. Excel dit qu'il ne trouve pas de données correpondantes.
Sub ChercherRemplacerDate()
Dim dat As Date, nouvdate As Date, cell As Range, total&
On Error Resume Next
dat = DateValue(InputBox("Date à remplacer :"))
If Err <> 0 Then Exit Sub
nouvdat = DateValue(InputBox("Remplacer par :"))
If Err <> 0 Then Exit Sub
Application.ScreenUpdating = False
For Each cell In ActiveSheet.UsedRange
If cell.Value2 = dat Then
cell.Value = nouvdat
total = total + 1
End If
Next
Application.ScreenUpdating = True
MsgBox "Terminé ! " & total & " remplacement(s) effectué(s)."
End Sub 'fs
Dim dat As Date, nouvdate As Date, cell As Range, total&
On Error Resume Next
dat = DateValue(InputBox("Date à remplacer :"))
If Err <> 0 Then Exit Sub
nouvdat = DateValue(InputBox("Remplacer par :"))
If Err <> 0 Then Exit Sub
Application.ScreenUpdating = False
For Each cell In ActiveSheet.UsedRange
If cell.Value2 = dat Then
cell.Value = nouvdat
total = total + 1
End If
Next
Application.ScreenUpdating = True
MsgBox "Terminé ! " & total & " remplacement(s) effectué(s)."
End Sub 'fs
Frédéric Sigonneau, (N°609)
Pourquoi la méthode find (date) ne marche -t-elle pas ? De même Range("A1").Value est
vide si la cellule contient une date.
Essaye avec Range("A1").Value2
Lorsqu'une cellule contient une date, sa
propriété Value2 contient le
numéro de série de la date.
Lorsqu'une cellule contient une date, sa
propriété Value2 contient le
numéro de série de la date.
Laurent Longre, (N°608)
J'ai besoin de tester chaque cellule d'une colonne qui contient des dates : si la valeur de la
cellule est égale ou inférieure à la date du jour, traitement, sinon rien.
Sub testDates()
Dim c As Range
For Each c In Selection
If c.Value <= Date And Not IsEmpty(c) Then
MsgBox "La cellule " & c.Address _
& " contient une date inférieure ou égale à la date du jour."
End If
Next c
End Sub
Remarque : employée en tant qu'instruction avec la syntaxe
Date=#nouvelleDate#, date sert à définir la date dans le programme et non à retrouver la date
du jour.
Utilisé en tant que fonction avec la syntaxe MaDate= Date, Date renvoie bien la date système
qui sera comparée à MaDate.
Dim c As Range
For Each c In Selection
If c.Value <= Date And Not IsEmpty(c) Then
MsgBox "La cellule " & c.Address _
& " contient une date inférieure ou égale à la date du jour."
End If
Next c
End Sub
Remarque : employée en tant qu'instruction avec la syntaxe
Date=#nouvelleDate#, date sert à définir la date dans le programme et non à retrouver la date
du jour.
Utilisé en tant que fonction avec la syntaxe MaDate= Date, Date renvoie bien la date système
qui sera comparée à MaDate.
ChrisV, (N°607)
Comment comparer une date entrée par un utilisateur à celle d'aujourd'hui ?
Sub ComparaisonDates()
Mavaleur = CDate(InputBox("Saisissez votre date"))
If Mavaleur > Date Then
SupInf = " est postérieur à aujourd'hui, "
ElseIf Mavaleur < Date Then
SupInf = " est antérieur à aujourd'hui, "
Else: SupInf = " c'est aujourd'hui, "
End If
MsgBox "le " & Mavaleur & SupInf & Date
End Sub
Mavaleur = CDate(InputBox("Saisissez votre date"))
If Mavaleur > Date Then
SupInf = " est postérieur à aujourd'hui, "
ElseIf Mavaleur < Date Then
SupInf = " est antérieur à aujourd'hui, "
Else: SupInf = " c'est aujourd'hui, "
End If
MsgBox "le " & Mavaleur & SupInf & Date
End Sub
Alain vallon, (N°606)
Comment faire pour chercher une date dans un classeur ?
Pour retrouver une date avec la méthode Find, c'est un peu tarabiscoté. Find ne
trouve les dates que si elles sont au format standard. Il faut donc sélectionner
la plage qui les contient, "mémoriser" leur format actuel, les passer au format
standard, faire la recherche puis restituer le format mémorisé. Un exemple pour
t'aider à démarrer (il n'y a aucun test d'erreur) :
Sub ChercherDate()
Dim Resultat As Range, FormatDates$, ATrouver As Long
'la date à trouver (Value2 donne la date au format standard)
ATrouver = Range("A4").Value2
'la plage de recherche (les cellules occupées sur une ligne 5)
Range("A5", Cells(5, Range("IV5").End(xlToLeft).Column)).Select
'format actuel des dates sélectionnées
FormatDates = Selection.NumberFormatLocal
'passage au format standard
Selection.NumberFormat = "General"
'recherche
Set Resultat = Selection.Find(ATrouver)
'remise au format de dates
Selection.NumberFormatLocal = FormatDates
'résultat de la recherche
Resultat.Select
End Sub
Cette astuce est illustrée dans ces classeurs exemples :
Warning: mysql_result() [function.mysql-result]: Unable to jump to row 0 on MySQL result index 41 in /home/misange/domains/excelabo.net/public_html/include/headexcel.php on line 230
Warning: mysql_result() [function.mysql-result]: Unable to jump to row 0 on MySQL result index 42 in /home/misange/domains/excelabo.net/public_html/include/headexcel.php on line 232
(téléchargé fois)
av-trouvedatejour (téléchargé 4473 fois)
trouve les dates que si elles sont au format standard. Il faut donc sélectionner
la plage qui les contient, "mémoriser" leur format actuel, les passer au format
standard, faire la recherche puis restituer le format mémorisé. Un exemple pour
t'aider à démarrer (il n'y a aucun test d'erreur) :
Sub ChercherDate()
Dim Resultat As Range, FormatDates$, ATrouver As Long
'la date à trouver (Value2 donne la date au format standard)
ATrouver = Range("A4").Value2
'la plage de recherche (les cellules occupées sur une ligne 5)
Range("A5", Cells(5, Range("IV5").End(xlToLeft).Column)).Select
'format actuel des dates sélectionnées
FormatDates = Selection.NumberFormatLocal
'passage au format standard
Selection.NumberFormat = "General"
'recherche
Set Resultat = Selection.Find(ATrouver)
'remise au format de dates
Selection.NumberFormatLocal = FormatDates
'résultat de la recherche
Resultat.Select
End Sub
Cette astuce est illustrée dans ces classeurs exemples :Warning: mysql_result() [function.mysql-result]: Unable to jump to row 0 on MySQL result index 41 in /home/misange/domains/excelabo.net/public_html/include/headexcel.php on line 230
Warning: mysql_result() [function.mysql-result]: Unable to jump to row 0 on MySQL result index 42 in /home/misange/domains/excelabo.net/public_html/include/headexcel.php on line 232
(téléchargé fois)
av-trouvedatejour (téléchargé 4473 fois)
Alain Vallon, (N°605)