|
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
|
|
|
|
|
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
|
|
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
|
|
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
|
|
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
|
|
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
|
|
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
|
|
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
|
|
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
|
|
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
|
|
Guest |