slash automatici data ed evento Worksheet_Change

[giulioc.tempestilli]

Mi sono "inventato" la seguente "rustica" funzione:
Public Function prova(z As String)
y = Len(Trim(z))
If y = 8 Then GoTo a
If y = 6 Then GoTo b
If y = 4 Then GoTo c
If InStr(1, z, "0") Then GoTo d
a:
giorno = Mid(z, 1, 2)
mese = Mid(z, 3, 2)
anno = Mid(z, 5, 4)
prova = giorno & "/" & mese & "/" & anno
Exit Function
b:
giorno = Mid(z, 1, 2)
mese = Mid(z, 3, 2)
anno = Mid(z, 5, 2)
prova = giorno & "/" & mese & "/" & anno
Exit Function
c:
giorno = "0" & Mid(z, 1, 1)
mese = "0" & Mid(z, 2, 1)
anno = Mid(z, 3, 2)
prova = giorno & "/" & mese & "/" & anno
Exit Function
d:
giorno = "0" & Mid(z, 1, 1)
mese = Mid(z, 2, 2)
anno = Mid(z, 4, 2)
prova = giorno & "/" & mese & "/" & anno

End Function
Praticamente cambia una stringa numerica in data mettendo automaticamente gli slash, vorrei farla diventare un evento Worksheet_Change con Set Rng = Range("A25:A500,e25:e500,g25:g500") ci sto provando da molto tempo ma non ci riesco.
Sono solo riuscito ad elaborare la seguente funzione che ovviamente non funziona.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
y = Len(Trim(z))
If y = 8 Then GoTo a
If y = 6 Then GoTo b
If y = 4 Then GoTo c
If InStr(1, z, "0") Then GoTo d

a:
Set Rng = Range("A25:A500,e25:e500,g25:g500")
Application.EnableEvents = False
If Not Intersect(Target, Rng) Is Nothing And Target.Count = 1 Then
giorno = Mid(z, 1, 2)
mese = Mid(z, 3, 2)
anno = Mid(z, 5, 4)
Target = giorno & "/" & mese & "/" & anno
Exit Sub
b:
Set Rng = Range("A25:A500,e25:e500,g25:g500")
Application.EnableEvents = False
If Not Intersect(Target, Rng) Is Nothing And Target.Count = 1 Then
giorno = Mid(z, 1, 2)
mese = Mid(z, 3, 2)
anno = Mid(z, 5, 2)
Target = giorno & "/" & mese & "/" & anno
Exit Sub
c:
Set Rng = Range("A25:A500,e25:e500,g25:g500")
Application.EnableEvents = False
If Not Intersect(Target, Rng) Is Nothing And Target.Count = 1 Then
giorno = "0" & Mid(z, 1, 1)
mese = "0" & Mid(z, 2, 1)
anno = Mid(z, 3, 2)
Target = giorno & "/" & mese & "/" & anno
Exit Sub
d:
Set Rng = Range("A25:A500,e25:e500,g25:g500")
Application.EnableEvents = False
If Not Intersect(Target, Rng) Is Nothing And Target.Count = 1 Then
giorno = "0" & Mid(z, 1, 1)
mese = Mid(z, 2, 2)
anno = Mid(z, 4, 2)
Target = giorno & "/" & mese & "/" & anno
Exit Sub
End Sub
grato anticipatamente dell'aiuto.

[Anthony47]

Non ho capito come fa la tua funzione a capire se 11217 indica il 1° dic o l'11 feb del 2017.

A parte cio', se la Function prova fa quello che ti serve, allora lascia il codice della Function (in un modulo standard del vba) e aggiungi la gestione del Worksheet_Change. Del tipo

Codice: Seleziona tutto

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
'
Set Rng = Range("A25:A500,e25:e500,g25:g500")
'
If Target.Value = "" Then Exit Sub
If Not Intersect(Target, Rng) Is Nothing And Target.Count = 1 Then
    Application.EnableEvents = False
    Target.Value = prova(Target.Value)
    Application.EnableEvents = True
End If
'
End Sub


Ciao

[giulioc.tempestilli]

grazie anthony, al momento come notato non lo riconosce e non ho idea di come risolverlo, sono io che inserisco un'enormità di dati e mi sono concesso il lusso di non inserire anche gli slash. Sarebbe interessante risolvere il problema.

[giulioc.tempestilli]

sto provando e purtroppo dopo 5 - 10 ripetizioni quando scrivo 290466 si trasforma in 00/7//04, vale anche per 29041966 e vias discorrendo, c'è qualche soluzione adottabile, al momento non mi viene alcuna idea.

[giulioc.tempestilli]

sto giocando con f9 e f8 dell'editor
Praticamente, dopo qualche prova - circa 5, avviene che z della funzione prova invece di "valorizzarsi" come la stringa digitata, ovvero 290466, assume il valore della corrispettiva data ovvero 07/04/2695 e il processo inizia male risultando 00/7//04, non mi sarei mai aspettato un andamento cosi eclettico della funzione, ci sono spazi di manovra per "normalizzare" la funzione? o devo gettare la spugna e ritornare a digitare gli slash? Grazie anticipatamente a tutti

[Anthony47]

Eh eh, sapevo che non si andava lontano...
Per avere speranza di lavorare in quel modo devi preventivamente formattare come "Testo" le celle interessate (quindi A25:A500,e25:e500,g25:g500); poi devi darti e rispettare una regola sul significato delle cifre che digiti; comunque il risultato sara un testo e non una vera data.
Ad esempio potresti importi di digitare giorni e mesi sempre con 2 cifre; per l'anno 2 0 4.
Con questi vincoli, potresti usare questa Worksheet_Change, al posto della precedente Worksheet_Change + la Function prova:

Codice: Seleziona tutto

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, tVal As String
'
Set Rng = Range("A25:A500,e25:e500,g25:g500")
'
If Target.Value = "" Then Exit Sub
If Not Intersect(Target, Rng) Is Nothing And Target.Count = 1 Then
    If IsNumeric(Replace(Target.Value, "/", "", , , vbTextCompare)) Then
        Application.EnableEvents = False
            tVal = Replace(Target.Value, "/", "", , , vbTextCompare)
            On Error Resume Next
            Target.Value = Format(DateValue((Left(tVal, 2) & "/" & Mid(tVal, 3, 2) & "/" & Mid(tVal, 5, 5))), "dd-mmm-yyyy")
'            Target.Value = Format(DateValue(Left(tVal, 2) & "/" & Mid(tVal, 3, 2) & "/" & Mid(tVal, 5, 5)), "dd/mm/yyyy")
            On Error GoTo 0
        Application.EnableEvents = True
    End If
End If
'
End Sub


Noterai che sono presenti, al centro del codice, 2 istruzioni "Target.Value = etc etc", di cui la seconda e' disabilitata; la prima (quella abilitata) inserisce la stringa dati nel formato 01-gen-2017; la seconda (quella disabilitata) nel formato 01/01/2017. Scegli tu quale usare, personalmente ritengo che 01-gen-2017 consenta meglio all'utente di capire se la data e' quella giusta.
Per "disabilitare" una istruzione basta inserire un "apostrofo" in testa alla riga; per "abilitare" quella adesso disabilitata vanno tolti gli apostrofi in testa alla riga.

Ciao

[giulioc.tempestilli]

Grazie