|
|
Rank: AiutAmico
Iscritto dal : 5/10/2010
Posts: 723
|
Ciao,
sto cercando di scrivere una macro che, partendo dalla selezione di una cella in Foglio 1, selezioni un range definito e lo copi in F.2 partendo dalla cella in col.K e trasponendone tutti i valori nella sola riga 46, ordinandoli nel contempo in senso crescente da sinistra a destra.
Alcune "frasi" della macro penso ormai di conoscerle, ma mi manca la sintassi pulita ed essenziale tipica delle macro di a10n11 :)))) (col registratore di macro di excel ne esce un poema omerico....)
ecco il testo da cui parto...
ActiveCell.Offset(-10, 1).Range("A1:E11").Select
ActiveCell.Activate
Selection.Copy
Sheets("F.2").Select
Range("K46").Select
ActiveSheet.Paste
...
Range("K46:BM46").Select
Selection.Sort Key1:=ActiveCell, Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
ove nella prima parte: da Foglio 1 e in cella attiva, la macro seleziona un'area adiacente alla colonna della cella attiva, ne copia il contenuto del Range in F.2 e nella seconda parte c'è l'istruzione per ordinare i valori.
Ho trovato una macro che fa una cosa simile, ma bisogna scrivere nella macro l'area da processare, e contiene un'istruzione che non conosco ecco il testo:
r = 46 'riga di destinazione
c = 11 'colonna di destinazione
For Each cella In Sheets("Foglio 1").Range("B207:FZ259")
Sheets("F.2").Cells(r, c).Formula = cella.Formula
r = 46 'ricomincia, sul foglio di destinazione
c = c + 1 'passando alla fascia successiva
Next
Ora agisco col registratore e tramite taglio metto tutto in colonna unica, faccio ordinare in senso crescente i dati e poi traspongo il tutto... Procedimento lontano anni luce dall'essenza pulita ed elegante delle 2 righe di istruzioni delle quali ormai sono innamorato... :))))
"A naso" penso che dovrei costruire una serie di brevi istruzioni che prendono i dati di ciascuna riga del range copiato e partendo dalla 1^ riga del Range li accodano via via fino all'ultima riga nell'unica riga di destinazione, la 46, per poi usare l'istruzione di ordinamento in senso crescente da sinistra a destra.....
Grazie infinite e buona giornata,
eZio
p.s. in questi 2 giorni di trasferta forzata, durante gli spostamenti in treno (altrimenti lunghi e noiosi) come da preziosissimo consiglio del mio caro Mentore ho letto con calma e concentrazione un po' del libro del Prof. Giaccaglini: è veramente molto interessante!! Come dicono gl'inglesi: step by step......... :)))
|
|
|
|
|
|
Rank: AiutAmico
Iscritto dal : 5/29/2003
Posts: 1,694
|
salve la mia soluzione al tuo quesito è quanto segue: Utilizzo una parte remota del foglio da riga 60000 in giù colonna da 200 a 256 del foglio attivo definisco il range da esportare : Set rng = ActiveCell.Offset(-10, 1).Resize(11, 5) 11 righe sopra la selezione e 5 colonne dopo la selezione. Ricopio tutto nella matrice "mycol" X = 1 For Each cl In rng mycol(X) = cl.Value X = X + 1 Next cl La riverso a partire da cella (60000,200) (GR60000) applico un ordinamento crescente Copio il range da GR60000 in giù e lo traspongo a partire a cella GS60000 Copio la riga nel foglio 2 a partire da cella K46 questo è il codice: Option Base 1 Sub copia() Dim mycol(55) riga = 60000 A = ActiveCell.Address Set rng = ActiveCell.Offset(-10, 1).Resize(11, 5) X = 1 For Each cl In rng mycol(X) = cl.Value X = X + 1 Next cl For n = LBound(mycol) To UBound(mycol) Cells(riga, 200).Value = mycol(n) riga = riga + 1 Next n Set rng = Nothing Set area = Range(Cells(60000, 200), Cells(60000, 200).End(xlDown)) area.Sort Key1:=Cells(60000, 200), Order1:=xlAscending area.Copy Cells(60000, 201).PasteSpecial Paste:=xlAll, Transpose:=True Selection.Copy Destination:=Sheets("foglio2").Range("k46") Application.CutCopyMode = False area.ClearContents Cells(60000, 201).Resize(, 55).ClearContents Set area = Nothing Range(A).Select End Sub saluti Giap
|
|
Rank: AiutAmico
Iscritto dal : 5/10/2010
Posts: 723
|
Ciao,
la macro selezionando ad esempio la cella attiva B34:
- in Foglio 1, col.GR da riga 60002 inolonna i codici e non cancella poi l'area di lavoro
- in foglio2 scrive solo, in cellaK46, il valore che in origine è in cella C24.
Ho provato a disattivare le istruzioni dalla riga seguente alla
Area.Sort Key1:=Cells(60000, 200), Order1:=xlAscending
Il risultato è una colonna (col.GR, la 200) da riga 60000 a 60055 con la riga 60001 saltata... i codici sono 55, ma c'è il sato di una riga...
:::::::::::::::
Una domanda da profano terra-terra: la macro che ho segnalato, a patto di scrivere il Range di lavoro, fa tutto il lavoro senza intoppi in 4 righe di istruzione...
Sto cercando di adattarla alle mie esigenze, cioè:
-Al posto di For Each cella In Sheets("Foglio 1").Range("B207:FZ259") inserire l'istruzione dell'area generata dalla cella attiva
Sheets("F.2").Cells(r, c).Formula = cella.Formula, di cui non conosco minimamente il significato, di fatto senza specificare null'altro di quanto in essa scritto prende l'area selezionata, la copia in F.2, la traspone partendo da cella K46...
Poi applicando a parte l'istruzione
Range("K46:BM46").Select
Selection.Sort Key1:=ActiveCell, Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
ordino i dati in senso crescente.
Misteri della Fede..... :))))
Grazie infinite e buona giornata, (qui piove a catinelle....)
eZio.
EDIT
Ho adattato la macro dalle sconosciute istruzioni ed ho inserito le mie coordinate. Chiedo scusa per il pasticcio assai poco corretto ed elegante che ne è uscito... ma all'atto pratico funziona tutto perfettamente! (Ripeto: Misteri della Fede!!)
E' chiaro che non sono per nulla soddifatto, dato che ci sono istruzioni di cui non conosco l'origine (pur restituendo i dati al loro posto...so solo che in quell'ambito ci si riferiva ad una formula i cui dati dovevano esser pur essi trasposti, per cui quell'istruzione includerebbe anche quell'evento) e per giunta non è assolutamente il mio modo di operare solitamente....
ecco le istruzioni che ho dato, premesso che:
-cella attiva in Foglio 1 col.B
- F.2 foglio di lavoro che mantiene riferimenti assoluti, che serve per manipolare e modificare dati a seconda delle esigenze interne
Sub trasposizione()
r = 46 'riga di destinazione
c = 11 'colonna di destinazione
ActiveCell.Offset(-10, 1).Range("A1:E11").Select
ActiveCell.Activate
Selection.Copy
Sheets("F.2").Select
Range("F46").Select
ActiveSheet.Paste
For Each cella In Sheets("F.2").Range("F46:J56")
Sheets("F.2").Cells(r, c).Formula = cella.Formula 'Cinese mandarino!!!!! Cosa significa? (funziona comunque: copia i dati di selezione...ho agito copiando prima i dati dal foglio con riferimenti relativi al foglio con riferimenti assoluti- che per mia fortuna ho già- e lavorando con quelle istruzioni su base fissa... un cavallo di Troia?!? :)) ...)
r = 46
c = c + 1
Next
Range("K46:BM46").Select
Selection.Sort Key1:=ActiveCell, Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
Range("F46:J56").ClearContents
Sheets("Foglio 1").Select
ActiveCell.Offset(9, -1).Range("A1").Select
End Sub
|
|
Rank: AiutAmico
Iscritto dal : 5/29/2003
Posts: 1,694
|
salve quella piccola riga in testa alla macro Option Base 1 dove l'hai scritta?? è in cima al modulo o in mezzo ad altre macro?? di solito passa inosservata ma ha la sua bella funzione. Il codice che hai postato tu, fondamentalmente fa la stessa cosa in maniera diversa. La tua copia tutto il range nel foglio2 e da lì lo scomponi la mia esegue tutto sul foglio1 e traspone la tabella esplosa a partire da cella K46 la riga definita cinese mandarino For Each cella In Sheets("F.2").Range("F46:J56") Sheets("F.2").Cells(r, c).Formula = cella.Formula, non fa altro che copiare il contenuto di "Cella" (Valore o formule contenute) nella cella( R,C) R= 46 C =11 che si incrementa di una unità ad ogni escussione del ciclo. se ad esempio Cella contenesse la formula =10*10 nella cella K46 sarà copiata la stessa formula =10*10 saluti Giap
|
|
Rank: AiutAmico
Iscritto dal : 5/29/2003
Posts: 1,694
|
salve una semplificazione del tutto in questa: Sub copia2() Dim mycol(55) Colonna = 11 A = ActiveCell.Address Set rng = ActiveCell.Offset(-10, 1).Resize(11, 5) X = 1 For Each cl In rng mycol(X) = cl.Value X = X + 1 Next cl For n = LBound(mycol) To UBound(mycol) Sheets("Foglio2").Cells(46, Colonna).Value = mycol(n) Colonna = Colonna + 1 Next n Set rng = Nothing With Sheets("foglio2") Set area = Range(.Cells(46, 11), .Cells(46, 11).End(xlToRight)) area.Sort Key1:=.Cells(46, 11), Order1:=xlAscending, Orientation:=xlLeftToRight End With Set area = Nothing End Sub saluti Giap
|
|
Rank: AiutAmico
Iscritto dal : 5/10/2010
Posts: 723
|
Ciao,
La macro (bellissima!!) funziona alla grande, è una meraviglia... c'era forse qualche dubbio?!? :))
Option Base 1 l'ho scritta in testa alla macro... Cosa significa e cosa fa quella piccola, ma fondamentate breve istruzione che modifica praticamente tutto l'esito della macro?
E' la prima volta che la vedo...
Grazie per la spiegazione dell'istruzione dagli occhi a mandorla... :)) Non l'avevo mai vista prima, e mi ha molto colpito che in un baleno facesse il lavoro di
ActiveCell.Activate
Selection.Copy
Sheets("F.2").Select
Range("F46").Select
ActiveSheet.Paste
Sospettavo che potesse fare un lavoro del genere (lavorarsi anche la formula interessata dalla sua influenza...), ma era troppo ermetica per un lattante come me...... :))
Grazie infinite e buona serata, corro subito a godermi l'ultima tua creatura...
eZio
|
|
Rank: AiutAmico
Iscritto dal : 5/29/2003
Posts: 1,694
|
salve Option Base può assumere il valore di 0/1 (Il valore predefinito è sempre 0) identifica il limite inferiore dell'indice di una matrice La nostra matrice è: Dim mycol(55) il valore 55 è il totale degli elementi della matrice se non avessimo utilizzato l'istruzione Option Base 1 , gli elementi totali della matrice sarebbero 56 in quanto il primo elemento avrebbe come indice 0 e 55 come ultimo. pertanto le righe del codice che sono condizionate dall'istruzione sarebbero: Dim mycol(55) che sarebbe dovuto essere Dim mycol(54) X = 1 che sarebbe dovuto essere X=0 Per quanto riguarda il codice che hai postato "Trasposizione" è utile nel caso tu debba copiare non solo il valore delle celle ma la formula in essa contenuta. saluti Giap
|
|
Rank: AiutAmico
Iscritto dal : 5/10/2010
Posts: 723
|
Ciao,
ho notato che quando il range che la macro processa è meno di 55 codici la macro "impazzisce" restituendo i dati in celle non adiacenti e non ordina più i dati... da cosa può dipendere?
Grazie assai e buon pomeriggio,
eZio
|
|
Rank: AiutAmico
Iscritto dal : 5/29/2003
Posts: 1,694
|
aetio ha scritto:Ciao,
ho notato che quando il range che la macro processa è meno di 55 codici la macro "impazzisce" restituendo i dati in celle non adiacenti e non ordina più i dati... da cosa può dipendere?
Grazie assai e buon pomeriggio,
eZio Salve la macro impazzirebbe se gli elementi dell'array fossero più di 55 nel caso fossero di meno si avrebbero elementi vuoti e non creerebbero il problema che sottoponi. esempio: dichiaro un array (5) -Option base 1 le mie celle che riempiono l'array sono solo 3 con i valori 10-20-30 il mio array sarà: 10-20-30-vuoto-vuoto siccome tale procedura è poco ortodossa, nel caso non si sappia a priori come dimensioare l'array, dovremo ridimensionarlo una volta conosciuta la sua reale dimensione. in questo modo: Dim mycol() senza specificare il numero di elementi ipotizzando che il nostro range finale da elaborare sia rappresentato dalla seguente istruzione: Set rng = ActiveCell.Offset(-10, 1).Resize(6, 5) che equivale a 30 celle da processare ora possiamo assegnare la dimensione del nostro array come segue: ReDim mycol(rng.Cells.Count) e la macro completa sarà questa: Sub copia2() Dim mycol() Colonna = 11 A = ActiveCell.Address Set rng = ActiveCell.Offset(-10, 1).Resize(6, 5) ReDim mycol(rng.Cells.Count) X = 1 For Each cl In rng mycol(X) = cl.Value X = X + 1 Next cl For n = LBound(mycol) To UBound(mycol) Sheets("Foglio2").Cells(46, Colonna).Value = mycol(n) Colonna = Colonna + 1 Next n Set rng = Nothing With Sheets("foglio2") Set area = Range(.Cells(46, 11), .Cells(46, 11).End(xlToRight)) area.Sort Key1:=.Cells(46, 11), Order1:=xlAscending, Orientation:=xlLeftToRight End With Set area = Nothing End Sub saluti Giap
|
|
Rank: AiutAmico
Iscritto dal : 5/10/2010
Posts: 723
|
Ciao,
Grazie assai ! Le tue spiegazioni sono talmente chiare e bene esposte che la Materia sembra cosa facile...
Buona giornata,
eZio
|
|
|
Guest |
