Aiutamici Forum
Benvenuto Ospite Cerca | Topic Attivi | Utenti | | Log In | Registra

[Excel 2007]- Macro per rinominare codici numerici in aree determinate Opzioni
aetio
Inviato: Thursday, November 03, 2011 5:02:30 PM

Rank: AiutAmico

Iscritto dal : 5/10/2010
Posts: 723
Ciao,
devo rinominare dei codici numerici all'interno dei fogli di lavoro, per cui credo che una macro potrebbe risolvermi elegantemente il problema.
Esempio:
in un foglio di lavoro tutti i numeri dei codici contenuti nelle celle da col. C (3^col.) a col.AZ (52^col.) dovrebbero essere rinominati col seguente schema:
1=Q
2=R
3=S
4=T
5=U
6=V
7=W
8=X
9=Y
0=Z
e per estensione:
12 (ad es.)=QR
45 (ad es.)=TU
105 (ad es.)=QZU
297 (ad es.)=RYW
etc.

Dato che anche nelle intestazioni vi sono dei numeri, che però non si riferiscono a codici e quindi non devono essere rinominati, se può essere cosa utile ho scritto le righe delle intestazioni delle tabelle usando il tipo di carattere Symbol (che è inconfondibile)...per cui si potrebbe istruire la macro a non variare le righe scritte in Symbol.
Grazie infinite e buona serata,
eZio
Sponsor
Inviato: Thursday, November 03, 2011 5:02:30 PM

 
a10n11
Inviato: Thursday, November 03, 2011 6:50:05 PM

Rank: AiutAmico

Iscritto dal : 5/29/2003
Posts: 1,694
salve
è da provare

Sub converti()
Uriga = Range("C" & Rows.Count).End(xlUp).Row
For n = 1 To Uriga
If Cells(n, 3).Font.Name <> "Symbol" Then
For Y = 3 To 52
cod = Cells(n, Y).Value
For a = 1 To Len(cod)
R = Mid(cod, a, 1)
Select Case R
Case 1
TRS = "Q"
Case 2
TRS = "R"
Case 3
TRS = "S"
Case 4
TRS = "T"
Case 5
TRS = "U"
Case 6
TRS = "V"
Case 7
TRS = "W"
Case 8
TRS = "X"
Case 9
TRS = "Y"
Case 0
TRS = "Z"
End Select
Transcode = Transcode & TRS
Next a
Cells(n, Y).Value = Transcode
Transcode = ""
Next Y
End If
Next n
End Sub

saluti
Giap

aetio
Inviato: Thursday, November 03, 2011 8:04:37 PM

Rank: AiutAmico

Iscritto dal : 5/10/2010
Posts: 723
a10n11 ha scritto:

è da provare


provata...sembra proprio PERFETTA!! (come sempre del resto)
Grazie infinite, buona serata
eZio
aetio
Inviato: Friday, November 04, 2011 10:30:58 AM

Rank: AiutAmico

Iscritto dal : 5/10/2010
Posts: 723
Ciao,
nel rinominare i codici la macro non rispetta le formattazioni date alle celle (ad es. i codici sono scritti in celle con allineamento a destra, le intestazioni sono scritte in celle con allineamento al centro, alcuni testi scritti in alcune celle sono scritti in grassetto, etc.), ma riscrive tutto con allineamento a sinistra... c'è magari un codice da aggiungere per far sì che la macro mantenga tutte le formattazioni date in origine alle celle? (....il solito rompiscatole ahahaha)

Grazie assai e buona giornata,
eZio
a10n11
Inviato: Friday, November 04, 2011 12:13:32 PM

Rank: AiutAmico

Iscritto dal : 5/29/2003
Posts: 1,694
salve
cos' su due piedi la soluzione che mi è venuta è questa:

Sub converti()
Application.ScreenUpdating = False
Uriga = Range("C" & Rows.Count).End(xlUp).Row
For n = 1 To Uriga
If Cells(n, 3).Font.Name <> "Symbol" Then
For Y = 3 To 52
Cells(n, Y).Copy
cod = Cells(n, Y).Value
For a = 1 To Len(cod)
R = Mid(cod, a, 1)
Select Case R
Case 1
TRS = "Q"
Case 2
TRS = "R"
Case 3
TRS = "S"
Case 4
TRS = "T"
Case 5
TRS = "U"
Case 6
TRS = "V"
Case 7
TRS = "W"
Case 8
TRS = "X"
Case 9
TRS = "Y"
Case 0
TRS = "Z"
End Select
Transcode = Transcode & TRS
Next a
Cells(n, Y).Value = Transcode
Cells(n, Y).PasteSpecial Paste:=xlFormats
Application.CutCopyMode = False
Transcode = ""
Next Y
End If
Next n
Application.ScreenUpdating = True
End Sub

saluti
Giap


aetio
Inviato: Friday, November 04, 2011 2:36:57 PM

Rank: AiutAmico

Iscritto dal : 5/10/2010
Posts: 723
Ciao,
eccellente idea!
però con le istruzioni Cells(n, Y).Copy e Cells(n, Y).PasteSpecial Paste:=xlFormats non voleva proprio saperne di funzionare...!! Mentre con rispettivamente Cells(n, Y).Select e
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

funziona alla grande... boh?? misteri della fede VBA :))
Sicuramente tu saprai darne spiegazione scientifica... ;)
(forse dipende dalla vers. 2007 di excel...?)
Grazie assai e buon pomeriggio
eZio
a10n11
Inviato: Saturday, November 05, 2011 10:21:17 AM

Rank: AiutAmico

Iscritto dal : 5/29/2003
Posts: 1,694
salve
l'istruzione PasteSpecial ti restituisce un errore?? se si quale?

Io ho utilizzato la strada di Incolla speciale ipotizzando che non tutte le celle siano formattate alla stessa maniera.
Colore di sfondo e colore di testo differenti. con il tuo codice cambi solo l'allineamento.
In ogni caso per snellire l'operazione eviterei ove possibile effettuare le selezioni, basta cambiare come segue:

With Cells(n, Y)
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
End With

saluti
Giap

aetio
Inviato: Saturday, November 05, 2011 11:27:23 AM

Rank: AiutAmico

Iscritto dal : 5/10/2010
Posts: 723
Ciao,
mi sono espresso male: non dava errore, ma non eseguiva l'istruzione lasciando le cose com'erano...
Grazie per la dritta... infatti gli altri codici sono solo d'impiccio.
Già che siamo in argomento ti sottopongo questo quesito, che non sono riuscito a risolvere: dato che queste modifiche dei codici identificheranno i componenti in modo diverso rispetto all'attuale (lo stesso componente avrà una sigla diversa dall'attuale) di sicuro tra sei mesi i miei "polli"- in senso buono... sono tutti bravissimi, ma come spesso accade non vedono più avanti del naso :)) - avranno necessità di risalire ai vecchi codici per rintracciare alcuni componenti, per cui sicuramente dovrò risalire velocemente ai vecchi codici identificativi... ho provato a scrivere una macro "speculare" per ritrasformare all'occorrenza le tabelle dalla nuova alla vecchia catalogazione... In pratica ho invertito
Case 1
TRS = "Q"
Case 2
TRS = "R"

etc. in
Case Q
TRS = "1"
Case R
TRS = "2"

etc. ma non funziona correttamente, restituendo codici diversi. Per quale motivo?


Se non ti creo un problema, potresti per favore spiegarmi in sintesi che significato hanno i codici
For a = 1 To Len(cod)
R = Mid(cod, a, 1)
Select Case R

Come al solito sempre gentilissimo................ e con una pazienza celestiale!! ;)
Grazie assai e buona giornata (qui in "Padania" piove a dirotto...)
eZio
a10n11
Inviato: Saturday, November 05, 2011 12:24:00 PM

Rank: AiutAmico

Iscritto dal : 5/29/2003
Posts: 1,694
salve
se guardi come hai posizionato i doppi apici, tiaccorgerai dell'errore..
Una stringa va racchiusa tra doppi apici un valore numerico no, quindi
Case "Q"
TRS = 1


For a = 1 To Len(cod)
R = Mid(cod, a, 1)
Select Case R

le istruzioni sopra indicate, servono per estrarre uno ad uno il contenuto della cella. "For a = 1 To Len(cod)"
sta a significare esegi il ciclo da 1 per tante volte la lunghezza del valore della cella

R = Mid(cod, a, 1) la variabile R rappresenta il carettere estratto dal valore della cella l'istruzione Mid
si legge: estrai dal valore della cella (Cod) a partire dalla posizione (a) (1) carattere

saluti
Giap






aetio
Inviato: Saturday, November 05, 2011 1:44:03 PM

Rank: AiutAmico

Iscritto dal : 5/10/2010
Posts: 723
Ciao,

a10n11 ha scritto:

se guardi come hai posizionato i doppi apici, tiaccorgerai dell'errore..
Una stringa va racchiusa tra doppi apici un valore numerico no, quindi
Case "Q"
TRS = 1


...che pollo!! sapevo che era una questione "formale", di scrittura che non rispettavo, però mi era sfuggito questo dettaglio basilare.
La spiegazione dei codici: tutto molto chiaro in poche frasi... come sempre ;)

Grazie assai e buon pomeriggio,
eZio

Utenti presenti in questo topic
Guest


Salta al Forum
Aggiunta nuovi Topic disabilitata in questo forum.
Risposte disabilitate in questo forum.
Eliminazione tuoi Post disabilitata in questo forum.
Modifica dei tuoi post disabilitata in questo forum.
Creazione Sondaggi disabilitata in questo forum.
Voto ai sondaggi disabilitato in questo forum.

Main Forum RSS : RSS

Aiutamici Theme
Powered by Yet Another Forum.net versione 1.9.1.8 (NET v2.0) - 3/29/2008
Copyright © 2003-2008 Yet Another Forum.net. All rights reserved.