>Per evitare di pressarti ci ho messo una
>pezza temporanea usando on error...
Due piccole "migliorie" (a me piacciono di più ;-) ) e l'eliminazione dell'on
error.
1)
a questa:
if Tipo <> 0 Then
ho preferito:
if isnumeric(Tipo2) then
in quanto nel primo caso zero è comunque un numero e quindi deve essere
copiato...a meno che vuoi trattarlo come caso particolare
2)
a questo pezzo:
<code>
For g = Val(e) to Val(f) ' Inizia il ciclo
rifa:
...
if Tipo = "" or Tipo2 = "" then ' se è vuota passa
' alla riga successiva
g = g+1
goto rifa
end if
</code>
ho preferito:
<code>
For g = Val(e) to Val(f) ' Inizia il ciclo
...
if not(Tipo = "" or Tipo2 = "") then ' se è vuota passa
[resto del codice]
end if
next g
</code>
Così ho tolto il "goto" e l'incremento manuale di "g" (che era la cosa che meno
mi piaceva, perché non l'avevo vista al primo colpo e mi chiedevo come facesse
a funzionare)
3)
Per quanto riguarda l'errore:
in verità, ti avevo già dato la dritta di dove andare a mettere il codice per
gestire eventuali stringhe (guarda nei commenti...per una volta che mi ero
messo a scriverli!!! ;-) )
>Se non riesce ad interpretare la stringa come un numero esce dal for,
>seleziona
>la cella incriminata e ti avverte..
Gli ho fatto colorare di rosso lo sfondo della cella, puoi fare quello che
ritieni più opportuno.
<code>
if (iPosizionePrimoPunto = 0 and iPosizionePrimaVirgola = 0) then
'Non ci sono nè virgole nè punti
'Potrebbe contenere del testo
'Ci sono varie cose da fare...
' QUALI???
oFoglio.getCellByPosition(NumCol+1, g ).setString(Tipo2)
oMycell = oFoglio.getCellByPosition(NumCol+1, g )
oMycell.CellBackColor = 16711680 ' = 4 'Valore ##.##0,00
else
</code>
Segue la sub completa.
Ciao!
Emanuele.
P.S.
Chiedo scusa per il thread spezzato...
REM ***** BASIC *****
Sub Che_Digerisce_Quasi_Tutto_e_Lo_Converte_In_Numeri() ' versione buona del
27/05/06
' da azionare con range pre-selezionato
'modificata con inserimento colonna
Dim d As long
Dim e As long
Dim f As long
Dim g As long
Dim Tipo As Double
Dim Tipo2 As String
dim oFoglio As Object
Dim oMycell As Object
Dim oMyRange As Object
Dim NumCol As Integer
Set oFoglio =
ThisComponent.Sheets.getByName(ThisComponent.currentcontroller.activesheet.name)
oSelections = ThisComponent.getCurrentSelection()
oMyRange=oSelections.getRangeAddress()
d = oMyRange.StartColumn 'getColonnaIniziale(a)
e = oMyRange.StartRow 'getRigaIniziale(a)
f = oMyRange.EndRow 'getRigaFinale(a)
NumCol = oMyRange.StartColumn ' definisce il numero della colonna
oFoglio.Columns.insertbyindex(d+1,1)
For g = Val(e) to Val(f) ' Inizia il ciclo
Tipo = oFoglio.getCellByPosition(NumCol, g).Value
Tipo2 = oFoglio.getCellByPosition(NumCol, g).String
' xray Tipo
' Xray Tipo2
if not(Tipo = "" or Tipo2 = "") then ' se è vuota passa
if isnumeric(Tipo2) then' <> 0 Then ' Se è un numero si limita a copiarlo
'e formattare la cella
oFoglio.getCellByPosition(NumCol+1, g ).setValue(Tipo)
oMycell = oFoglio.getCellByPosition(NumCol+1, g )
oMycell.NumberFormat = 4 'Valore ##.##0,00
Else ' Altrimenti fa una serie di controlli per determinare
' che tipo di stringa è
' se trova dei caratteri di testo o delle celle vuote
' salta alla cella dopo
if InStr(Tipo2, "'") > 0 then
Tipo2 = join(split(Tipo2,"'"),"")
Tipo2 = Trim(Tipo2)
end if
Dim h As Integer
Dim i As Integer
Dim l As String
Dim iPosizionePrimoPunto as integer
Dim iPosizionePrimaVirgola as integer
iPosizionePrimoPunto = InStr(Tipo2, ".")
iPosizionePrimaVirgola = InStr(Tipo2, ",")
if (iPosizionePrimoPunto = 0 and iPosizionePrimaVirgola = 0) then
'Non ci sono nè virgole nè punti
'Potrebbe contenere del testo
'Ci sono varie cose da fare...
' QUALI???
oFoglio.getCellByPosition(NumCol+1, g ).setString(Tipo2)
oMycell = oFoglio.getCellByPosition(NumCol+1, g )
oMycell.CellBackColor = 16711680 ' = 4 'Valore ##.##0,00
else
if iPosizionePrimoPunto = 0 then
'Ci sono solo virgole
if InStr(iPosizionePrimaVirgola + 1, Tipo2) > 0 then
'C'è più di una virgola, allora sarà
' un separatore di migliaia
'Lo rimuovo
Tipo2 = join(split(Tipo2, ","), "")
else
'Cè solo una virgola
if (((len(Tipo2) - iPosizionePrimaVirgola) < 3)or ((len(Tipo2) -
iPosizionePrimaVirgola) > 4))then
'La virgola ha meno di due o più di 4 alla
'sua destra, allora è quasi certamente
'un separatore di decimali
'Quindi non facciamo niente
else
'La virgola ha esattamente 3
'cifre alla sua
'destra, può essere un separatore di
'decimali, ma anche un
'separatore di migliaia,
'non posso decidere cosa fare...
end if
end if
end if
if iPosizionePrimaVirgola = 0 then
if InStr(iPosizionePrimoPunto + 1, Tipo2) > 0 then
'Cè più di un punto, allora sarà un
'separatore di migliaia
'Lo rimuovo
Tipo2 = join(split(Tipo2, "."), "")
else
'C'è un solo punto
if (((len(Tipo2) - iPosizionePrimoPunto)< 3) or ((len(Tipo2) -
iPosizionePrimoPunto)> 4)) then
'Il punto ha meno di due o più di 4
'alla sua destra,
'allora è quasi certamente
'un separatore di decimali
'Allora sostituiamo il punto con una
'virgola
Tipo2 = join(split(Tipo2, "."), ",")
else
'Il punto ha esattamente 3 cifre
'alla sua destra, può
'essere un separatore di
'decimali, ma anche un
'separatore di migliaia, non
'posso decidere cosa fare...
end if
end if
end if
if ((iPosizionePrimoPunto > iPosizionePrimaVirgola)and (iPosizionePrimaVirgola
> 0)) then
'Ragionevolmente il punto sarà il separatore dei decimali
'Togliamo le virgole come separatore delle migliaia
Tipo2 = join(split(Tipo2, ","),"")
'Sostituiamo il punto con la virgola come separatore dei decimali
Tipo2 = join(split(Tipo2, "."),",")
end if
if ((iPosizionePrimoPunto < iPosizionePrimaVirgola)and (iPosizionePrimoPunto >
0)) then
'Ragionevolmente la virgola sarà il separatore dei decimali
'Togliamo i punto come separatori delle migliaia
Tipo2 = join(split(Tipo2, "."),"")
'E la virgola la lasciamo alsuo posto
end if
oFoglio.getCellByPosition(NumCol+1, g ).setValue(cDbl(Tipo2))
oMycell = oFoglio.getCellByPosition(NumCol+1, g )
oMycell.NumberFormat = 4
end if
end if
end if
Next
end sub
------------------------------------------------------------
Sei stanco di girare a vuoto?
Con il nuovo motore di ricerca Interfree trovi di tutto.
Vieni a trovarci: http://search.interfree.it/
Lo Staff di Interfree
------------------------------------------------------------
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
