VBA:sostituire catteri accentati

[draleo]

Salve,
ho tre colonne di dati ;cognome,nome,città
Per ciascuno di questi valori dovrei
-identificare l'ultima lettera della parola
-se questa è una lettera accentata : à,è,ì,ò,ù
dovrei sostituirla rispettivamente con: a,e,i,o,u
Questo perchè ,dovendo salvare il file in formato XML, questo da
errore se incontra caratteri accentati
Grazie a chi mi aiuterà a fare una procedura rapida (le colonne
contengono circa 15.000 righe ed è quindi fondamentale che la
procedura sia più rapida possibile)
grazie
draleo

[Scossa]

La soluizone più rapida è quella di utilizzare il metodo .find.
Nel codice che segue ipotizzo la preventiva selezione del range su cui
sostituire i caratteri, inoltre sostituisco le accentate con la coppia
vocale più apostrofo (è -> e'):

Public Sub Accentate2()

Dim rng As Range

Set rng = Selection
'oppure:
'Set rng = range("A3:C15000") ' da adattare

' è -> e' altrimenti
'togli gli apostrofi se vuoi è -> e etc.
'l'apostrofo in sostituzione dell'accentata

rng.Replace What:="à", Replacement:="a'", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False,
_
ReplaceFormat:=False
rng.Replace What:="è", Replacement:="e'", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False,
_
ReplaceFormat:=False
rng.Replace What:="é", Replacement:="e'", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False,
_
ReplaceFormat:=False
rng.Replace What:="ì", Replacement:="i'", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False,
_
ReplaceFormat:=False
rng.Replace What:="ò", Replacement:="o'", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False,
_
ReplaceFormat:=False
rng.Replace What:="ù", Replacement:="u'", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False,
_
ReplaceFormat:=False

Set rng = Nothing

End Sub
'----------------

Fai sapere, grazie

Bye!
Scossa

[Scossa]

On 9 Ott, 23:05, Scossa <scossa...@gmail.com> wrote:
> On 9 Ott, 08:44, draleo <dra...@libero.it> wrote:
> La soluizone più rapida è quella di utilizzare il metodo .find.
> Nel codice che segue ipotizzo la preventiva selezione del range su cui
> sostituire i caratteri, inoltre sostituisco le accentate con la coppia
> vocale  più apostrofo (è -> e'):
>
> Public Sub Accentate2()
>

Dimenticavo: visto che interessa molte celle meglio aggiungere
all'inizio:

Application.ScreenUpdating = False

e poi rimetterlo a True prima di end sub.

Bye!
Scossa

[r]

beh non sarebbe un buon lavoro ... xml accetta tutti i caratteri e che
li codifica in modo particolare ... prova questo codice ho adattato la
routine per creare l'xlm (anche se ripeto era roba datata e ora non ho
tempo di migliorarla) aggiungendo una funzione che codifica i
caratteri in modo corretto (almeno mi sembra) ... incollo tutto il
test provalo su una cartella nuova ... in pratica fa tutto da solo ...
crea una tabella di 10 colonnne con tutte le 255 ascii (meno le 32
iniziali non stampabili) nelle righe ... poi converte e salva il file
xml sul desktop (ho usato environ per l'indirizzo dell'userprofile ma
non è detto che il tuo pc abbia questa environstring (credo di si
comunque perchè è una delle più diffuse) ... in alternativa cambia il
percorso ...

ecco il codice ... prova e fai sapere:

Sub test()
Dim i As Long, l As Long

For i = 1 To 10
Cells(1, i) = "colonna" & i
Next

For i = 1 To 10
For l = 2 To 255 - 31
Cells(l, i) = Chr(l + 30)
Next
Next
scrivi_xml [a1:j224]
End Sub


Sub scrivi_xml(rng As Excel.Range)
Dim coltit() As Variant
Dim arrxml() As Variant
Dim str As String
Dim nome_file_xml As String
Dim i As Long
Dim tblnome1 As String
Dim tblnome2 As String
Dim a As Long
Dim rig1 As Long
Dim col1 As Long
Dim rigtot As Long
Dim coltot As Long
Dim Z As Long
Dim s As String

rig1 = rng.Row
col1 = rng.Column

rigtot = rng.Rows.Count
coltot = rng.Columns.Count

s = XML_Sostituisci_Escape(ActiveSheet.Name)
tblnome1 = "<" & s & ">"
tblnome2 = "</" & s & ">"

ReDim arrxml(rigtot + 1)
ReDim coltit(coltot, 1)
'popolo la matrice con i titoli delle colonne e i tag di chiusura
For i = 0 To coltot - 1
coltit(i, 0) = "<" & _
XML_Sostituisci_Escape(Cells(rig1, col1 + i)) & ">"
coltit(i, 1) = "</" & _
XML_Sostituisci_Escape(Cells(rig1, col1 + i)) & ">"
Next i

arrxml(0) = "<dataroot>"
Z = 1
str = ""

For i = 1 To rigtot - 1
str = str & tblnome1 & Chr(10)
For a = 0 To coltot - 1
str = str & coltit(a, 0) & _
XML_Sostituisci_Escape(Cells(rig1 + i, col1 + a)) & _
coltit(a, 1) & Chr(10)

Next a
str = str & tblnome2
arrxml(Z) = str
Z = Z + 1
str = ""
Next i

arrxml(Z) = "</dataroot>"

Call scrivi_file_testo(arrxml())
End Sub
Sub scrivi_file_testo(arr As Variant)
Dim nome_file_txt As String
Dim val As Variant
Dim nome As String
nome = Replace(ThisWorkbook.Name, ".xls", ".xml")

nome_file_txt = Environ("USERPROFILE") & "\Desktop\" & nome
Open nome_file_txt For Output As #1
For Each val In arr
Print #1, val
Next
Close #1
End Sub
Public Function XML_Sostituisci_Escape( _
ByVal Testo As String) As String
'______________________________________________
'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
'Di Roberto Mensa nick r
'______________________________________________
'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
'Prepara il testo ad essere scritto in XML
Dim i As Long
Dim tempL As Long
Dim h As String
For i = 1 To Len(Testo)
tempL = Asc(Mid$(Testo, i, 1))
Select Case tempL
Case 48 To 57, 65 To 90, 97 To 122
h = h & Chr(tempL)
Case Else
h = h & "&#" & CStr(tempL) & ";"
End Select
Next i
XML_Sostituisci_Escape = h
End Function

saluti
r

[draleo]

Non ho parole!
Eccezionale!
(devo controllare meglio cosa trovo nel file generato XML, ma mi
sembra fantastico)
grazie
draleo

[roberto mensa]

Ok però non mi rilasso fino a quando mi dici va bene conoscendoti
troverai di sicuro qualche magagna :-)

Il 10/10/10, draleo<dra...@libero.it> ha scritto:

[draleo]

Puoi rilassarti. E' eccezionale . tutti i caratteri ASCII strani si
ritrovano nel file XML generato
senza alcuna segnalazione di errore.
Ora devo applicare il tutto ai miei riferimenti e penso che mi
occorrerà tutta la nottata
Ma intanto un quesito mi è venuto subito in mente:
Con la tua vecchia versione del file io richiamavo la routine
scrivi_xml
Nella quale dichiaravo il mio range (rge) dove si trovavano i dati e
che era così fatta
Sub scrivi_xml()

Set WB = ActiveWorkbook
With WB.Sheets("record")
Set ultimacella = .UsedRange.SpecialCells(xlLastCell)
Set rge = Range(.Range("A1"), ultimacella)
End With
Ecc ..
Ecc..
End sub

Ora invece
Nella routine test tu chiami la macro scrivi_xml [a1:j224] ,
dandogli un range di riferimento [a1:j224] che non è il mio
come trasformo la chiamata
scrivi_xml [a1:j224]
in modo che si riferisca al mio range ?

Veramente fenomenale!!
grazie mille
draleo

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

[draleo]

Funziona benissimo. Anche l'idea di sostituire gli accenti con gli
apostrofi non l'avevo avuta
Grazie anche a te (stamane non avevo visto il post)
draleo

[draleo]

la routine di r così come sopra riportata funziona benissimo, come
già detto stamane.
Ma (e qui purtroppo sarò preso ancora per un piantagrane)quando vado
ad aggiungerci l'altra parte della procedura (come appare nell'altro
forum) per criptare e decriptare mi da 2 errori
1)la funzione criptstr, alla riga c= chr(asc(Mid(str,i,1)+ correz)
mi da errore di run time 5 (chiamata di routine non valida)
e mi blocca la criptazione alla riga 222 (non cripta quindi le ultime
2 righe)
Se pero cambio il range da [a1:j224] sostituendolo con [a1:j222]
allora la routine prosegue fini alla fina e genera il file XML
2)Ma tale file è vuoto ed appare la scritta
A name was started with an invalid character. Error processing
resource 'file:///C:/Documents and Settings/Leo/Desktop...
<&#42;&#35;>&#42;&#36;</&#42;&#35;>
-^
Mi sembra quindi che non accetti questi caratteri
draleo

[Scossa]

On 10 Ott, 22:39, draleo <dra...@libero.it> wrote:
> la routine di r così come sopra riportata  funziona benissimo, come
> già detto stamane.

Scusa draleo,
ma se il problema e quello della riservatezza non è più semplice e
sicuro zippare con password il file xlm ed inviare lo .zip
(comunicando ovviamente privatamente la pswd al destinatario)?

Bye!
Scossa

[roberto mensa]

quoto!

per i problemi che hai evidenziato draleo, non ho analizzato la routine che cripta e decripta però evidentemente utilizza alcuni ascii non stampabili ...

saluti

r

 

[eliano]

Ciao Roby.
Quella routine cripta aggiungendo delle costanti numeriche al
carattere ascii da criptare.
E' quasi inevitabile che vada fuori range XML.
Anche se inserisci un controllo del chr e modifichi il segno della
costante, avrai il problema degli omonimi.
Penso che sia il caso di riscriverla mantenendo inalterato il set di
caratteri e giocare sulla scambio di posizione, ma poichè non credo
che qualcuno tenterà di decodificare i dati del Dottore, la soluzione
con password e fogli nascosti dovrebbe essere la più semplice e
funzionale.
Fumate confermate,
Eliano


On 10 Ott, 23:36, roberto mensa <robb....@gmail.com> wrote:

[draleo]

>Scusa draleo,
>ma se il problema e quello della riservatezza non è più semplice e
>sicuro zippare con password il file xlm ed inviare lo .zip
>(comunicando ovviamente privatamente la pswd al destinatario)?
>Bye!
>Scossa

No, è il destinatario –oltre ai vari curiosi che potrebbero cercare di
vedere i cavoli degli altri- che non deve vedere i dati personali
sensibili;

>ma poichè non credo
>che qualcuno tenterà di decodificare i dati del Dottore

>Eliano

Non ne sono tanto sicuro. Se trasmetto tali dati, devo avere la
ragionevole certezza che siano indecifrabili nei dati
personali:cognome,nome,Codfisc ecc

>Penso che sia il caso di riscriverla mantenendo inalterato il set di
>caratteri e giocare sulla scambio di posizione

>Eliano

Si è così. Ma io non ne sono capace. Se qualcuno mi aiuta a trovare la
soluzione bene;
altrimenti li cripto a random utilizzando i caratteri ascii che vanno
da 63 a 125.
Certo in tal caso, non potrei –né io né alcun altro- più decriptarli.
Dovrei conservare per me una copia in chiaro
draleo