macro per modificare il formato della data

[pinhead....@gmail.com]

Ciao,

non sono per nulla pratico di macro, ma sono quasi riuscito a
costruirmi una macro per cambiare il formato della data in un foglio
Excel.
Nel fogli che mi passano, le date sono scritte nel formato
[spazio]ggmmaa
(7 caratteri, il primo e´ sempre uno spazio)

Vedendo un po´di roba in giro sulla rete, ho scritto questa macro:

Sub cambiaFormatoData()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

For Each cell In Selection.Cells

MyString = ""
FinalString = ""
dd = ""
mm = ""
yy = ""

MyString = cell.Text
dd = Mid(MyString, 2, 1) & Mid(MyString, 3, 1)
mm = Mid(MyString, 4, 1) & Mid(MyString, 5, 1)
yy = Mid(MyString, 6, 1) & Mid(MyString, 7, 1)

FinalString = dd & "/" & mm & "/" & yy
cell.Value = FinalString
cell.NumberFormat = "dd/mm/yy"

Next

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

Il risultato non e´ pero´ quello desiderato:
se la data inizia con 0 (tipo " 040209) la macro trasforma il tutto in
una data, ma con giorno e mese interpretate all´americana (risultato 2-
apr-09). In caso contrario il risultato viene modificato come voglio,
ma Excel continua a considerarlo testo puro.

Dove sbaglio?

Grazie.
PinHead

[scos...@gmail.com]

On 20 Mar, 16:24, pinhead.cenobi...@gmail.com wrote:
>
> Il risultato non e´ pero´ quello desiderato:
> se la data inizia con 0 (tipo " 040209) la macro trasforma il tutto in
> una data, ma con giorno e mese interpretate all´americana (risultato 2-
> apr-09). In caso contrario il risultato viene modificato come voglio,
> ma Excel continua a considerarlo testo puro.
>
> Dove sbaglio?
>

Prova così:

Sub cambiaFormatoData()
Dim cell As Range
Dim FinalString As String, MyString As String
Dim i As Integer

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

For Each cell In Selection.Cells

MyString = ""
FinalString = ""
MyString = Mid(cell.Text, 2, 2) & "/" & _
Mid(cell.Text, 4, 2) & "/" & Mid(cell.Text, 6, 2)
cell.Value = Format(MyString, "dd/mm/yy")

[pinhead....@gmail.com]

> Prova così:
>
> Sub cambiaFormatoData()
[cut]

Stesso risultato. X-P

Continua ad interpretare in modo differente il risultato a seconda che
la data inizi per zero o per un altro numero.

[robb...@gmail.com]

On 20 Mar, 16:24, pinhead.cenobi...@gmail.com wrote:

ho modificato la tua e aggiunto una variante
vedi te ....

Sub cambiaFormatoData()
Dim cell As Excel.Range
Dim mystring As String
Dim FinalString As String
Dim dd As String
Dim mm As String
Dim yy As String

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

For Each cell In Selection.Cells

mystring = ""

FinalString = ""
dd = ""
mm = ""
yy = ""

mystring = cell.Text
dd = Mid(mystring, 2, 1) & Mid(mystring, 3, 1)
mm = Mid(mystring, 4, 1) & Mid(mystring, 5, 1)
yy = Mid(mystring, 6, 1) & Mid(mystring, 7, 1)

FinalString = DateSerial(CLng(20 & yy), CLng(mm), CLng(dd))

cell.Value = FinalString
cell.NumberFormat = "dd/mm/yy"

Next

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub
'in alternativa ...

Sub cambiaFormatoData2()
Dim cell As Excel.Range
Dim mystring As String
Dim FinalString As String
Dim dd As String
Dim mm As String
Dim yy As String

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

For Each cell In Selection.Cells

cell.Value = InData(cell.Text)

Next

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub
Function InData(t As String)
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")

RE.Global = True
RE.Pattern = "^\s(\d\d)(\d\d)(\d\d)$"
With RE
If .test(t) Then
InData = Format(DateSerial( _
CLng(.Replace(t, "$3")), _
CLng(.Replace(t, "$2")), _
CLng(.Replace(t, "$1"))), "dd/mm/yy")
End If
End With
End Function

saluti
r

[pinhead....@gmail.com]

> Continua ad interpretare in modo differente il risultato a seconda che
> la data inizi per zero o per un altro numero.

Mi correggo. Fa lo scambio tra mese e giorno dove ha senso ( 100309 ->
3-oct-2009 e non 10-mar-09 come dovrebbe essere), mentre dove questo
scambio non puo´ essere fatto ( 260309) lascia una stringa di testo.

[robb...@gmail.com]

> r- Nascondi testo citato
>
> - Mostra testo citato -

dimenticavo ... indate la puoi usare come udf
(funzione definita dall'utente)
gli anni di 2 cifre vengono interpretati da 0 a 29
come 2000 gli altri 1900 volendo si può modificare
nuovamente
saluti
r

[Mauro Gamberini]

Stesso risultato. X-P

Continua ad interpretare in modo differente il risultato a seconda che
la data inizi per zero o per un altro numero.

***************************************************

Aspettando r.e., prova:

Dim d as date

d = MyString
cell.Value = d

--
---------------------------
Mauro Gamberini
http://www.riolab.org/
http://blog.maurogsc.eu/

[pinhead....@gmail.com]

> ho modificato la tua e aggiunto una variante
> vedi te ....

[cut]

Ancora lo stesso problema.
Ho verificato anche le impostazioni internazionali del pc, ma sono
quelle italiane standard.

[Mauro Gamberini]

<cut>

Fai questa prova:

Public Sub m()

Dim s As String
Dim d As Date
Dim sh As Worksheet

s = "02/04/2009"
d = s

Set sh = Worksheets("Foglio1")

With sh
.Range("A1").Value = s
.Range("A2").Value = d
End With

Set sh = Nothing

End Sub

Manca il controllo della validità della data.

[robb...@gmail.com]

hai le celle formattate come testo immagino ...
prova

Sub cambiaFormatoData2()
Dim cell As Excel.Range
Dim mystring As String
Dim FinalString As String
Dim dd As String
Dim mm As String
Dim yy As String

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

For Each cell In Selection.Cells

cell.ClearFormats
cell.Value = InData(cell.Text)
cell.NumberFormat = "dd/mm/yy;@"

Next

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub
Function InData(t As String)
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")

RE.Global = True
RE.Pattern = "^\s(\d\d)(\d\d)(\d\d)$"
With RE
If .test(t) Then

InData = DateSerial( _

CLng(.Replace(t, "$3")), _
CLng(.Replace(t, "$2")), _
CLng(.Replace(t, "$1")))

[Mauro Gamberini]

<ricut>

Non è sera.... voleva essere:

Public Sub m()

Dim s As String
Dim d As Date
Dim sh As Worksheet

s = "02/04/2009"
d = CDate(s)

Set sh = Worksheets("Foglio1")

With sh
.Range("A1").Value = s
.Range("A2").Value = d
End With

Set sh = Nothing

End Sub

Ma anche:

.Range("A2").Value = CDate(s)

Manca sempre l'eventuale controllo
sulla validità della stringa passata a
CDate.

[Scossa]

In article <8bb776b3-d2b9-40f5-8196-
6ba80b...@p11g2000yqe.googlegroups.com>, pinhead....@gmail.com
says...

> Continua ad interpretare in modo differente il risultato a seconda che
> la data inizi per zero o per un altro numero.

Ti confermo che sui miei pc funziona benisssimo.

Comunque prova questa variante:

'======================
Option Explicit

Sub cambiaFormatoData()
Dim cell As Range
Dim FinalString As String, MyString As String

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

For Each cell In Selection.Cells

cell.NumberFormat = "@"

MyString = ""
FinalString = ""
MyString = Mid(cell.Text, 2, 2) & "/" & _

Mid(cell.Text, 4, 2) & "/" & _

Mid(cell.Text, 6, 2)
cell.Value = Format(MyString, "dd/mm/yy")
cell.NumberFormat = "dd/mm/yy"

Next

With Application
.Calculation = xlCalculationAutomatic
ScreenUpdating = True
End With

End Sub

'======================

--

Bye!

Scossa

[Scossa]

In article <MPG.242dffb86...@news.individual.net>,
inv...@gmai.com says...

> In article <8bb776b3-d2b9-40f5-8196-
> 6ba80b...@p11g2000yqe.googlegroups.com>, pinhead....@gmail.com
> says...

> ScreenUpdating = True

ovviamente ho mangiato il punto:
.ScreenUpdating = True

--

Bye!

Scossa

[pinhead....@gmail.com]

> ovviamente ho mangiato il punto:
>         .ScreenUpdating = True

Funziona! Quasi perfettamente...
Le date vengono scritte correttamente, ma rimangono formattate come
testo. Pero´ se le seleziono con il mouse e premo enter vengono
trasformate in date. Mistero...

[pinhead....@gmail.com]

> hai le celle formattate come testo immagino ...
> prova
> Sub cambiaFormatoData2()

[cut]

Finalmente ho avuto modo di provare tutti i suggerimenti su un altro
pc.
Questa macro effettivamente risolve tutti i problemi.
Le altre macro lasciano le celle formattate come testo, mentre con
questa sono formattate correttamente.

Comunque grazie a tutti per l'aiuto.
PinHead