vba excel: rintracciare una data all'interno di una stringa

[karug64]

Salve a tutti.

Questa volta posto una domanda che difficilmente troverà risposta, ma ci provo ugualmente ....

ho delle celle dal contenuto vario (di testo) al cui interno "potrebbe" essere contenuta una data scritta in vari formati (10.11.1999 / 10/12/1998 / 15.1.2004 / 20.04.20 / 20/04/97 ecc).

Quindi potrei trovare un valore del tipo:

"In data 20.04.1997 si è verificato questo e quest'altro"
"15/1/19: acquistato dal fornitore xxxxx"
"Ricevuto dalla ditta yyyyy il materiale ordinato il 10/12/1998 e rivenuto al prezzo di llll"

e così via.

Sarebbe possibile, all'interno di un ciclo for, leggere le celle e intercettare le eventuali date contenute all'interno ?

Grazie

[Dylan666]

Sì, ma devi usare delle Regex:
https://www.myonlinetraininghub.com/reg ... ions-excel

https://stackoverflow.com/questions/792 ... match-date

[Anthony47]

Dylan, il primo link che hai pubblicato contiene una dei migliori tutorial sull'uso delle Regex.
Lavorando col vba si puo' ottenere qualcosa di piu', ad esempio con una Funzione presonalizzata come questa:

Codice: Seleziona tutto

Function AnyDate(ByVal myStr As String) As Variant
Dim mySplit, I As Long, aWord As String, evData
Dim aKill, aConv
'
aConv = Array(".", "-")                     '<<< Caratteri da convertire
aKill = Array(":", ",", ";", "!", "?")      '<<< Caratteri da eliminare
'Elimina i pericolosi:
For I = 0 To UBound(aKill)
    myStr = Replace(myStr, aKill(I), " ", , , vbTextCompare)
Next I
'Converti i possibili separatori:
For I = 0 To UBound(aConv)
    myStr = Replace(myStr, aConv(I), "/", , , vbTextCompare)
Next I
mySplit = Split(myStr, " ", , vbTextCompare)
For I = 0 To UBound(mySplit) - 1
    evData = ""
    On Error Resume Next
        evData = DateValue(mySplit(I))
    On Error GoTo 0
    If IsDate(evData) Then
        AnyDate = evData
        Exit For
    End If
Next I
End Function


Il codice va messo in un modulo standard del vba, poi sul tuo foglio puoi scrivere una formula del tipo

Codice: Seleziona tutto

=AnyDate(B14)


Sono risolte anche date scritte come 20-maggio-12, oppure 7-gen, oppure 7-genn; comunque meglio di quanto possa fare la Function RegExDate descritta nel secondo link di Dylan

Gli unici separatori ammessi sono "/" "." e "-"
"Giocando" sulle due righe marcate <<< puoi migliorare la situazione, man mano che trovi scritte fantasiose.

Ciao

[Dylan666]

Faccio solo una domanda per vedere se ho capito il codice.
Nel caso in cui la riga riportasse un prezzo espresso come € 10.20 (quindi con il punto) ma non una data, non creerebbe un "falso positivo"?

[karug64]

Grazie infinte ad entrambi.

Anthony:

ma se la stringa contiene più date ? E' possibile estrarle tutte (magari concatenate, se più semplice) ?

Grazie

[karug64]

Mi rispondo.
Avrei sistemato apportando le modifiche contrassegnate con ' <===:

Codice: Seleziona tutto

Function AnyDate(ByVal myStr As String) As String ' <===
Dim mySplit, I As Long, aWord As String, evData
Dim aKill, aConv

Dim d As String ' <===
'
aConv = Array(".", "-")                     '<<< Caratteri da convertire
aKill = Array(":", ",", ";", "!", "?")      '<<< Caratteri da eliminare
'Elimina i pericolosi:
For I = 0 To UBound(aKill)
    myStr = Replace(myStr, aKill(I), " ", , , vbTextCompare)
Next I
'Converti i possibili separatori:
For I = 0 To UBound(aConv)
    myStr = Replace(myStr, aConv(I), "/", , , vbTextCompare)
Next I
mySplit = Split(myStr, " ", , vbTextCompare)

d = ""

For I = 0 To UBound(mySplit) - 1
    evData = ""
    On Error Resume Next
        evData = DateValue(mySplit(I))
    On Error GoTo 0
   
   
    If IsDate(evData) Then
        If Len(Trim(d)) = 0 Then    ' <===
            d = evData              ' <===
        Else                        ' <===
            d = d & " - " & evData  ' <===
        End If                      ' <===
       
        AnyDate = d                 ' <===
        'Exit For                   ' <===
   
    End If
Next I

Ho, però un problema: se all'interno della cella ci sono date ed importi estrae date sbagliate. Tipo:

11/07/2013 SETTORE ABBIGLIAMENTO IN VENDITA PRESSO ALTRO PUNTO VENDITA 05/2013 PER EURO 4.000,00

Mi estrae le date: 11/07/2013 - 01/05/2013 - 01/04/2000.

Grazie

[Anthony47]

Nel caso in cui la riga riportasse un prezzo espresso come € 10.20 (quindi con il punto) ma non una data, non creerebbe un "falso positivo"?

Eh gia'... i falsi positivi con l'impostazione data non mancheranno

Per evitare i piu' clamorosi, come con "€ 10.10" possiamo mettere piu' vincoli, ad esempio che la stringa sia lunga almeno xx caratteri; ad es con >5 mi sembra rimangano molte possibilita' aperte; ad esempio 01.gen e' letto come 1 gennaio (ma non lo sara' 1.gen).
Anche tenendo presente la richiesta di restituire tutte le date presenti nella stringa, il nuovo codice potrebbe essere

Codice: Seleziona tutto

Function AnyDate(ByVal myStr As String) As Variant
Dim mySplit, I As Long, aWord As String, evData
Dim aKill, aConv
'
aConv = Array(".", "-")                     '<<< Caratteri da convertire
aKill = Array(":", ",", ";", "!", "?")      '<<< Caratteri da eliminare
'Elimina i pericolosi:
For I = 0 To UBound(aKill)
    myStr = Replace(myStr, aKill(I), " ", , , vbTextCompare)
Next I
'Converti i possibili:
For I = 0 To UBound(aConv)
    myStr = Replace(myStr, aConv(I), "/", , , vbTextCompare)
Next I
mySplit = Split(myStr, " ", , vbTextCompare)
For I = 0 To UBound(mySplit)
    If Len(mySplit(I)) > 5 Then
        evData = ""
        On Error Resume Next
            evData = DateValue(mySplit(I))
            If evData < 1 Then evData = ""
        On Error GoTo 0
        If IsDate(evData) Then
            AnyDate = AnyDate & " - " & Format(evData, "dd-mmm-yyyy")    '<<< Formato DATA
        End If
    End If
Next I
AnyDate = Mid(AnyDate, 4)
End Function


Ciao a tutti

[karug64]

Ok. Grazie mille !!