XL 2010 Tranformer une série de chiffre en date

LAPIN-53 · 22 Juin 2020

Bonjour je crée un fichier dans le quel je voudrais transformer automatiquement une serie de chiffre en date :
si je tape dans ma cellule K1 : 01012020, j'aimerais voir apparaitre 01/01/2020.
Il s'agit d'un fichier qui n'est pas forcément rempli par moi et le équipe demande à ne pas avoir à taper les /
Merci d'avance pour votre aide

jmfmarques · 22 Juin 2020

Bonjour

j'aimerais voir apparaitre 01/01/2020.

s'il ne s'agit que d'affichage, le format personnalisé 00\/00\/0000 fera l'affaire, mais n'en fera pas une date pour autant. Et il te faudra donc encore intervenir (avec VBA) pour transformer ce texte en date.

et le équipe demande à ne pas avoir à taper les /

Explique à "le équipe" qu'il est abusif d'alourdir un code pour de tels prétextes.

job75 · 22 Juin 2020

Bonjour LELIEVRE, jmfmarques,

Placez dans le code de la feuille (clic droit sur l'onglet et Visualiser le code) :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Intersect(Target, [A:A], UsedRange) 'à adapter
If Target Is Nothing Then Exit Sub
Target.NumberFormat = "General" 'format Standard
For Each Target In Target 'si entrées multiples (copier-coller)
    If Target Like "########" Then If IsDate(Format(Target, "00\/00\/0000")) Then _
        Target = CDate(Format(Target, "00\/00\/0000")): Target.NumberFormat = "dd/mm/yyyy"
Next
End Sub

Seules les valeurs entrées en colonne A sont traitées.

A+

job75 · 22 Juin 2020

Pour tester j'ai entré la valeur 22062020 sur toute la plage A1:A10000.

La macro s'exécute chez moi en 5,9 secondes, c'est acceptable.

patricktoulon · 22 Juin 2020

bonjou a tous
@job75 tu veux bien m'expliquer ceci
Set Target = Intersect(Target, [A:A], UsedRange) 'à adapter

job75 · 22 Juin 2020

Bonjour patricktoulon,

patricktoulon à dit:
@job75 tu veux bien m'expliquer ceci
Set Target = Intersect(Target, [A:A], UsedRange) 'à adapter

Pourquoi le UsedRange ? Sans lui quand on efface toute la colonne A les 1048576 cellules sont étudiées.

patricktoulon · 22 Juin 2020

re@job75
à d'accords le 3eme argument n'est la que si le change est pour empty
pour éviter de trotter pour rien ;il fallait y penser
je teste pas mais si il y a d'autre cellule dans d'autre colonnes ça risque de déclencher me trompai-je?

bien vu

job75 · 22 Juin 2020

patricktoulon à dit:
je teste pas mais si il y a d'autre cellule dans d'autre colonnes ça risque de déclencher me trompai-je?

Oui tu te trompes.

patricktoulon · 22 Juin 2020

ok j'ai testé
et non c'est bien uniquement la colonne A qui est controllée
étonnant cette trouvaille
par contre avec un msgbox on se rend bien compte que l'event se redéclenche apres la conversion
je laisse le msgbox

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
MsgBox Intersect(Target, [A:A], UsedRange).Address
Set Target = Intersect(Target, [A:A], UsedRange)  'à adapter
If Target Is Nothing Then Exit Sub
Application.EnableEvents = False
Target.NumberFormat = "General" 'format Standard
For Each Target In Target 'si entrées multiples (copier-coller)
    If Target Like "########" Then If IsDate(Format(Target, "00\/00\/0000")) Then _
        Target = CDate(Format(Target, "00\/00\/0000")): Target.NumberFormat = "dd/mm/yyyy"
Next
Application.EnableEvents = True
End Sub

tes 5 secondes devraient descendre un peu je pense

job75 · 22 Juin 2020

patricktoulon à dit:
par contre avec un msgbox on se rend bien compte que l'event se redéclenche apres la conversion

Oui bien sûr mais si la plage étudiée n'et pas trop grande (*) les Application.EnableEvents sont inutiles.

(*) Il faut bien voir que la plupart du temps une seule cellule est entrée et modifiée.

patricktoulon · 22 Juin 2020

re
oui sauf si une autre macro est lancée dans cet event
ça mange pas de pain de les laisser
en tout cas j'aurais appris quelque chose aujourd'hui
je suis pas sur de bien comprendre comment ca marche car pour moi les arguments d'intersect ont toujours été des plages a prendre en compte
il faudrait que je trouve de la doc sur ce point peut etre y a t il des subtilités que j'ignore

job75 · 22 Juin 2020

Il n'y a aucune subtilité dès qu'on a compris ce qu'est une intersection.

Edit : pour info sur la plage A1:A10000 les Application.EnableEvents font passer de 5,5 s à 1,4 seconde.

patricktoulon · 22 Juin 2020

oui j'ai compris
pour moi basique ment
Set Target = Intersect(Target, [A:A], UsedRange) 'à adapter
voulais dire
target est l'intersection de target et A:A ou/et target et le usedrange
je viens donc de tester et non ça n'est pas cela

pour m'en assurer j'ai fait ce test
MsgBox Intersect(Target, [A:A],[C:C]).Address
déclenche une erreur donc = nothing

et j'ai fait celui avec la méthode que j'utilise habituellement
MsgBox Intersect(Target, [A:A,C:C]).Address
j'ai bien l'address de la cellule et B:B est bien exceptée de l'équation

il est donc maintenant clair que le test se fait avec l'argument (2) et les autres arguments ont une autre fonction
je pencherais donc pour "ET AUSSI"

autrement dit
les x plages en argument doivent elles aussi se croiser sinon c'est un nothing

edit:
rectification
l'intersection doit être effective dans tout les plages arguments
donc avec cette méthode les non contiguës ont oublie

en gros cette méthode détermine le end(xlup) avec le usedrange pour la plage argument(2)
et non une seconde plage
elle est là la subtilité ton argument (usedrange)a 2 fonctions

eu t il fallu que je le susse

patricktoulon · 22 Juin 2020

quand je dis qu'il y a une subtilité c'est pas pour rien
à tester dans un fichier vierge

VB:

Private Sub Worksheet_Activate()
[A1,B20] = "aaa"
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    use1 = UsedRange.Address & vbCrLf
    inter = "erreur intersection"
    On Error Resume Next
    inter = Intersect(Target, [A1:A20], [A1:B20]).Address
    Err.Clear
    use2 = UsedRange.Address
    MsgBox "usedrange=" & use1 & vbCrLf & inter & vbCrLf & "usedrange=" & use2
End Sub

tape en A puis en B
pourtant il est incontestable que l'intersection est effective
purée c'est encore un truc qui va me taraudé jusqu’à qu' une réponse certifié MS me sera fourni

job75 · 22 Juin 2020

Je m'étonne que tu ne comprennes pas que :

VB:

Intersect(a, b, c)

c'est la même chose que :

VB:

Intersect(Intersect(a, b), c)

et que Intersect(Target, [A:A],[C:C]) ce n'est pas du tout Intersect(Target, [A:A,C:C])

puisque que [A:A,C:C]) c'est l'union de 2 plages.

XL 2010 Tranformer une série de chiffre en date

LAPIN-53

XLDnaute Nouveau

jmfmarques

XLDnaute Accro

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Discussions similaires