Excel: Creazione Macro

[marcopont]

Ciao a tutti,

ho un aiuto da chiedervi:
ho N dati distribuiti nella colonna A.
vorrei creare una macro che mi copi a intervalli di 4 righe in 4 righe i dati e li incolli nello Sheet2 in orizziontale.
Ad Es:
i dati A1:A4 in A1:D1
i dati A5:A8 in A2:D2
etc...

Mi aiutate....se si puo' fare?
Grazie
Marco

[Jonlord]

Ma no ma che nervi stavo postando e mi si è cancellato tutto il mess xke 'forum chiuso'....

[Jonlord]

Allora dicevo che secondo me puoi fare tutto con una formula ben piazzata. Ora non c'ho voglia di riscrivermi tutto quello che mi si è cancellato.

Cmq nel foglio due piazza la formula andando in orizzontale del tipo

Codice: Seleziona tutto

=Sheet1!$A1
=Sheet1!$A2
=Sheet1!$A3
=Sheet1!$A4...

* il $ serve a far usare sempre la colonna A anche se ti sposti a destra.

Scegli bene i tuoi strumenti, non è detto che si possa al primo colpo riportare tutti i valori dalla forma orizzontale alla verticale. Magari ti serivrà un passaggio intermedio dove cominci a filtrare tutti i valori x avere gli intervalli di 4.

Ad es:
c x v + p
4 x 0 + 1
4 x 0 + 2
4 x 0 + 3
4 x 0 + 4

4 x 2 + 1
4 x 2 + 2
4 x 2 + 3
4 x 2 + 4
...

La vedi la logica?
Il 4 è costante c.
Al variare di v (= numero che è sempre pari), sommando i numeri p (= da 1 a 4) ottieni tutti i numeri di riga dai quali devi leggere.

[marcopont]

Grazie Jonlord per la celere risposta ma non capisco (sono acerbo con il sw) come fa, una volta copiate le prime 4, a passare alla 5 e cosi' via....
Ti scrivo nello specifico cosa ho a disposizione:
a1:cognome
a2:indirizzo
a3:citta
a4 telefono
a5:cognome
a6:indirizzo
a7:citta
a8 telefono
.
.
.
.
.....e mi deve copiare cosi':
a1:cognome....b1:indirizzo...c1:citta....d1:telefono
a2:cognome....b2:indirizzo...c2:citta....d2:telefono


Grazie mille

[Jonlord]

Dunque si complica.... hmmm
ho fatto delle prove ma sono solo riuscito ad ottere i numeri di riga dove devi leggere.... estrarne i contenuti mi riesce piu difficile...

Xke io ho nella colonna D (verde):
1
2
3
4
9
10
11
12
...
Ma non posso usarli x dire
leggi A(D1); A(D2)....
Guarda questo screenshot

[Anthony47]

Hai l' elenco su Foglio1.
Vai su Foglio2 cella A2 (su riga 1 inserirai le intestazioni di colonna) e inserisci la formula

Codice: Seleziona tutto

=SCARTO(Foglio1!$A$1;(RIF.RIGA()-2)*4+RIF.COLONNA()-1;0)

Copi questa formula su B2:D2 (selezioni A2, Contr-c, selezioni B2:D2, Contr-v)
Poi copi A2:D2 verso il basso per quanto serve (selezioni A2:D2, Contr-c, selezioni A3:A100 ad esempio, Contr-v).

Ciao, fai sapere.

[marcopont]

Grazie Anthony.....ottimo

[marcopont]

Ragazzi approfitto della vostra competenza....

sempre relativamente alla mia richiesta di prima, alla quale Anthony ha brillantemente risposto, vi pongo un altro quesito:
E' possibile effettuare l'operazione di cui sopra laddove i dati da copiare fossero intervallati (random) da una riga bianca?
Es:
a1:cognome
a2:indirizzo
a3:citta
a4 telefono
a5:cognome
a6:indirizzo
a7:citta
a8 telefono
a9:BIANCA
a10:cognome
a11:indirizzo
a12:citta
a13:telefono

sempre grazire
Marco

[Ribonix]

Se non sono arrivato tardi con la storia delle 4 righe...

Codice: Seleziona tutto

Do
 If Sheets("Foglio1").Cells(RIGA + 1, 1).Value = "" Then Exit Do
 Sheets("Foglio2").Cells(Int((RIGA) / 4) + 1, COLONNA + 1).Value = Sheets("Foglio1").Cells(RIGA + 1, 1).Value
 COLONNA = (COLONNA + 1) And 3
 RIGA = RIGA + 1
Loop

Bye

[marcopont]

Grazie Ribonix....non sei arrivato tardi....pero' con il tuo codice se incontra una riga bianca si ferma....io invece vorrei che passasse avanti e copiasse le successive 4...
si puo'?

[marcopont]

....ragazzi mi andrebbe bene anche un codice che elimini le righe bianche nell'elenco da far partire prima della macro che copia....

grazie ancora

[Ribonix]

Potresti provare così:

Codice: Seleziona tutto

ULTIMA_RIGA = ActiveCell.SpecialCells(xlLastCell).Row
ULTIMA_RIGA = (Int(ULTIMA_RIGA / 4) - ((ULTIMA_RIGA / 4) <> Int(ULTIMA_RIGA / 4))) * 4
Do
 If Sheets("Foglio1").Cells(RIGA + 1, 1).Value = "" And RIGA + 1 > ULTIMA_RIGA Then Exit Do
 Sheets("Foglio2").Cells(Int((RIGA) / 4) + 1, COLONNA + 1).Value = Sheets("Foglio1").Cells(RIGA + 1, 1).Value
 COLONNA = (COLONNA + 1) And 3
 RIGA = RIGA + 1
Loop

La macro quando legge l'ultima riga dell'elenco prosegue finchè la riga corrente non è un multiplo di 4. E a questo punto termina.

[marcopont]

no ragazzi non va....
da questo elenco
a
b
c
d

e
f
g
h
i
l
m
n

o
p
q
r
s
t
u
v

mi copia cosi'
a b c d
e f g
h i l m
n o p
q r s t
u v

io invece vorrei o eliminare le righe bianche a monte oppure saltare alla successiva e contarne 4 ogni volta che ne incontra una bianca

[Ribonix]

Così?

Codice: Seleziona tutto

ULTIMA_RIGA = ActiveCell.SpecialCells(xlLastCell).Row
Do
 If Sheets("Foglio1").Cells(RIGA + 1, 1).Value = "" And RIGA + 1 > ULTIMA_RIGA Then Exit Do
 If Sheets("Foglio1").Cells(RIGA + 1, 1).Value = "" Then
    Sheets("Foglio1").Cells(RIGA + 1, 1).Delete Shift:=xlUp
    ULTIMA_RIGA = ULTIMA_RIGA - 1
 End If
 Sheets("Foglio2").Cells(Int((RIGA) / 4) + 1, COLONNA + 1).Value = Sheets("Foglio1").Cells(RIGA + 1, 1).Value
 COLONNA = (COLONNA + 1) And 3
 RIGA = RIGA + 1
Loop

Bye.

[Anthony47]

La macro postata da Ribonix l’ ho provata e funziona nelle condizioni descritte da marcopont; aggiungerei solo in testa

Codice: Seleziona tutto

Sheets("Foglio1").Activate

per assicurare che ULTIMA_RIGA sia calcolata correttamente.

Inoltre, per sfiducia verso il calcolo fatto di Excel di UsedRange (e su questo chiedo l’ opinione di Ribonix), tendo a calcolare l’ ultima cella col metodo .End(xlUp), quindi avrei scritto:
ULTIMA_RIGA = Range("A65536 ").End(xlup).Row

Non gestisce l’ eventuale doppia interlinea.

Se la doppia interlinea fosse un problema, questa macro gestisce anche questa situazione:

Codice: Seleziona tutto

Sub marcop()
Sheets("Foglio1").Activate
For Each Cella In Range("A1", Range("A65536").End(xlUp))
If Cella = "" Then
  CBlank = CBlank + 1
  Else
    Cella.Copy Destination:=Sheets("Foglio2").Range("A1").Offset(1 + Int((Cella.Row - CBlank - 1) / 4), OffCol)
    OffCol = (OffCol + 1) Mod 4
End If
Next Cella
End Sub

I dati vengono scritti su Foglio2 da riga 2 in giu', nell' ipotesi che riga 1 sia per i titoli di colonna; se preferisco scrivere da riga 1, allora trasforma questa parte
...Offset(1 + Int((Cella.Row - etc etc
in

Codice: Seleziona tutto

....Offset(Int((Cella.Row - etc etc

Ciao, fai sapere.

[Ribonix]

La macro postata da Ribonix l’ ho provata e funziona nelle condizioni descritte da marcopont; aggiungerei solo in testa

Codice: Seleziona tutto

Sheets("Foglio1").Activate

per assicurare che ULTIMA_RIGA sia calcolata correttamente.

Mi fermo solo a questa prima parte del post. Per il resto del messaggio lo guarderò con calma e ti darò una risposta.
In effetti sono entrato nel vivo delle istruzioni della macro sottointendendo che bisogna almeno specificare il nome del foglio sul quale si vuole operare. Grazie x la precisazione.

x ULTIMA_RIGA = Range("A65536 ").End(xlup).Row non vedo particolari controindicazioni: l'importante è arrivare a leggere l'ultimo dato di una lista vuoi partendo dal fondo del foglio come nel tuo caso (forse + corretto) o arrivando a leggere dal sistema qual è l'ultima riga dove sono stai inseriti i dati... Forse nel mio caso se io inserisco un dato fino all'ipotetica riga N e poi cancello il dato della riga N il sistema considera comunque la riga N come ultima riga dei dati... per fargli capire che l'ultima riga di dati è la N-1 bisognerebbe salvare il foglio...

[marcopont]

perfettissimo.....:-))))

grazie