| | Post: 2 | Registrato il: 06/12/2016
| Città: MILANO | Età: 43 | Utente Junior | excel 2013 | | OFFLINE | |
|
06/12/2016 16:11 | |
Buongiorno a tutti spero di trovare un'anima buona che mi possa aiutare, ho un foglio excel che allego in cui ho due colonne con le celle che identificano le colonne in verticale con nome indirizzo telefono e fax e la colonna successiva con i nomi effettivi indirizzi effettivi ecc. ecc.
Ora ho la necessità di incolonnare tutto da verticale ad orizzontale e ho bisogno di automatizzare il tutto perchè ho migliaia di righe, mi potete aiutare.
Grazie Mille
|
|
| | Post: 764 | Registrato il: 24/04/2004
| Città: TERAMO | Età: 63 | Utente Senior | 2010 | | OFFLINE |
|
06/12/2016 17:30 | |
Ciao.
Se l'altezza in righe delle schede fosse sempre uguale(nell'esempio allegato non è così) si può usare questa procedura:
Option Explicit
Const cRighe = 20
Public Sub Incolonna()
Dim lRiga As LongPtr, rTabella As LongPtr
Dim Elenco As Range, Tabella As Range
Set Elenco = Range("A2")
Set Tabella = Range("F1")
rTabella = 1
For lRiga = 1 To cRighe Step 2
Tabella(rTabella, lRiga \ 2) = Elenco(lRiga, 1)
Next lRiga
Do While Elenco <> ""
rTabella = rTabella + 1
For lRiga = 1 To cRighe Step 2
Tabella(rTabella, lRiga \ 2) = Elenco(lRiga, 2)
Next lRiga
Set Elenco = Elenco(cRighe, 1)
Loop
Set Elenco = Nothing
Set Tabella = Nothing
End Sub
altrimenti la cosa si complica un pò. [Modificato da Zer0kelvin 06/12/2016 17:31] __________________________
[Excel 2010]
-Condividere la conoscenza aumenta la ricchezza di tutti.
-Dai ad un uomo un pesce e lo avrai sfamato per un giorno; insegnagli a pescare e lo avrai sfamato per sempre. (Confucio)
-Il sonno della ragione genera mostri. (Francisco Goya) |
| | Post: 2 | Registrato il: 06/12/2016
| Città: MILANO | Età: 43 | Utente Junior | excel 2013 | | OFFLINE | |
|
06/12/2016 17:39 | |
Grazie per la risposta e la formula, che devo inserire come marco nel foglio excel? Giusto? Scusami ma non sono molto pratico.
Grazie ancora
|
| | Post: 3.534 | Registrato il: 13/03/2012
| Città: LIVORNO | Età: 78 | Utente Master | 2010 | | OFFLINE | |
|
06/12/2016 17:44 | |
la macro sarebbe questa
Sub trasp()
LR = Cells(Rows.Count, "A").End(xlUp).Row
dr = 2
dc = 6: LC = 15
For r = 2 To LR Step 19
For c = dc To LC
Cells(dr, c) = Cells(r + (c - dc) * 2, 2)
Next
dr = dr + 1
Next
End Sub
ma funziona soltanto se il numero delle righe di ciascuna sezione è sempre lo stesso, cosa che nell'esempio non è rispettata
----------
Win 10 - Excel 2010
allega un file di esempio, guadagnerai tempo tu e lo farai risparmiare a chi ti aiuta |
| | Post: 3 | Registrato il: 06/12/2016
| Città: MILANO | Età: 43 | Utente Junior | excel 2013 | | OFFLINE | |
|
06/12/2016 17:50 | |
Quindi il codice che hai scritto prima è VBA
|
| | Post: 4 | Registrato il: 06/12/2016
| Città: MILANO | Età: 43 | Utente Junior | excel 2013 | | OFFLINE | |
|
06/12/2016 17:54 | |
Ho provato ed effettivamente, come hai detto se non sono regolari viene fuori un pasticcio.
Come potrei ovviare a questo disallineamento?
|
| | Post: 3.535 | Registrato il: 13/03/2012
| Città: LIVORNO | Età: 78 | Utente Master | 2010 | | OFFLINE | |
|
06/12/2016 18:11 | |
correggere i dati oppure trovare una logica, perché cambia il num di righe ?
----------
Win 10 - Excel 2010
allega un file di esempio, guadagnerai tempo tu e lo farai risparmiare a chi ti aiuta |
| | Post: 5 | Registrato il: 06/12/2016
| Città: MILANO | Età: 43 | Utente Junior | excel 2013 | | OFFLINE | |
|
06/12/2016 19:16 | |
E' un problema di dati, ovvero alcuni nominativi riportano il telefono altri no e quindi nella estrapolazione originaria del file non vi era omogeneità nei dati-
Ora provo a verificare la corretta corrispondenza.
Grazie ancora.
|
| | Post: 2.244 | Registrato il: 27/09/2010
| Città: FIRENZE | Età: 61 | Utente Veteran | Excel 2010 | | OFFLINE | |
|
06/12/2016 19:21 | |
Ciao,
mi confermi che usi Excel 2013?
Nella cella A324 manca l'indicazione "Nome".
Fatta questa correzione, puoi lavorare probabilmente con una formula
In F2 copia in basso ed a destra
=SE.ERRORE(INDICE($B$1:$B$1000;AGGREGA(15;6;RIF.RIGA($1:$1000)/($A$1:$A$1000=F$1);RIGHE($A$1:$A1)));"")
A patto che per ogni nome siano indicate le informazioni da riportare nella colonne.
Saluti [Modificato da (Canapone) 06/12/2016 19:26]
|
| | Post: 6 | Registrato il: 06/12/2016
| Città: MILANO | Età: 43 | Utente Junior | excel 2013 | | OFFLINE | |
|
06/12/2016 19:38 | |
Ti confermo Excel 2013 ora provo.
|
| | Post: 2.245 | Registrato il: 27/09/2010
| Città: FIRENZE | Età: 61 | Utente Veteran | Excel 2010 | | OFFLINE | |
|
06/12/2016 19:53 | |
Ciao,
l'ho fatta troppo semplice. Correggo le formule.
Uso una colonna di servizio
In C2 da copiare accanto al tuo database
=SE(A2="Nome";B2;C1)
In F2 va bene da copiare solo in basso per i nomi
=SE.ERRORE(INDICE($B$1:$B$1000;AGGREGA(15;6;RIF.RIGA($1:$1000)/($A$1:$A$1000=F$1);RIGHE($A$1:$A1)));"")
In G2 da copiare in basso ed a destra
=SE.ERRORE(INDICE($B$1:$B$1000;CONFRONTA($F2&G$1;INDICE($C$1:$C$1000&$A$1:$A$1000;);0));"")
Così dovrebbe andare
Saluti
|
| | Post: 7 | Registrato il: 06/12/2016
| Città: MILANO | Età: 43 | Utente Junior | excel 2013 | | OFFLINE | |
|
06/12/2016 20:05 | |
Ho corretto questa riga =SE(A2="Nome";B2;C1) mettendo uno spazio al posto del c1 sennò mi riportava sempre lo stesso nome trascinandola giù.
Il resto lo stò testando.
|
| | Post: 8 | Registrato il: 06/12/2016
| Città: MILANO | Età: 43 | Utente Junior | excel 2013 | | OFFLINE | |
|
06/12/2016 20:06 | |
Al momento mi congedo e ti ringrazio infinitamente. A domani che sicuramente avrò bisogno del tuo aiuto.
GRazie |
| | Post: 2.248 | Registrato il: 27/09/2010
| Città: FIRENZE | Età: 61 | Utente Veteran | Excel 2010 | | OFFLINE | |
|
06/12/2016 20:15 | |
Ciao,
gentilissimo.
Allego il file dove ho fatto le prove
Saluti
|
| | Post: 765 | Registrato il: 24/04/2004
| Città: TERAMO | Età: 63 | Utente Senior | 2010 | | OFFLINE |
|
06/12/2016 20:17 | |
Soluzione a "forza bruta"
Public Sub Incolonna2()
Dim lRiga As LongPtr, rTabella As LongPtr, I As LongPtr, Last As LongPtr
Dim Elenco As Range, Tabella As Range
Dim Headers As Variant, nHeaders As Long, pHeader As Long
'==
Headers = Array("Nome", "Nascita:", "Ordine:", "Iscrizione:", "Sezione/Settore:" _
, "Altro:", "E-mail:", "Telefono:", "Fax:", "Indirizzo Studio:")
nHeaders = UBound(Headers) + 1
Set Elenco = Range("A1")
Set Tabella = Range("D1")
For I = 1 To nHeaders
Tabella(1, I) = Headers(I - 1)
Next I
rTabella = 1
lRiga = 1
Last = Cells(Rows.Count, 1).End(xlUp).Row
Do While lRiga < Last
lRiga = lRiga + 1
If Elenco(lRiga, 1) = Headers(0) Then
rTabella = rTabella + 1
Tabella(rTabella, 1) = Elenco(lRiga, 2)
Else
pHeader = HPos(Headers, Elenco(lRiga, 1))
If pHeader > 0 Then
Tabella(rTabella, pHeader + 1) = Elenco(lRiga, 2)
End If
End If
Loop
Set Elenco = Nothing
Set Tabella = Nothing
End Sub
...anche se un poco in ritardo, vedo. [Modificato da Zer0kelvin 06/12/2016 20:21] __________________________
[Excel 2010]
-Condividere la conoscenza aumenta la ricchezza di tutti.
-Dai ad un uomo un pesce e lo avrai sfamato per un giorno; insegnagli a pescare e lo avrai sfamato per sempre. (Confucio)
-Il sonno della ragione genera mostri. (Francisco Goya) |
| | Post: 9 | Registrato il: 06/12/2016
| Città: MILANO | Età: 43 | Utente Junior | excel 2013 | | OFFLINE | |
|
07/12/2016 09:30 | |
Ringrazio tutti ma proprio tutti per il supporto che mi avete dato. Grazie |
| | Post: 3.536 | Registrato il: 13/03/2012
| Città: LIVORNO | Età: 78 | Utente Master | 2010 | | OFFLINE | |
|
07/12/2016 09:54 | |
Zer0kelvin, mi sembra interessante il tuo approccio, potresti spiegarlo ? hai dimenticato di allegare la funzione hpos [Modificato da patel45 07/12/2016 09:59]
----------
Win 10 - Excel 2010
allega un file di esempio, guadagnerai tempo tu e lo farai risparmiare a chi ti aiuta |
| | Post: 768 | Registrato il: 24/04/2004
| Città: TERAMO | Età: 63 | Utente Senior | 2010 | | OFFLINE |
|
08/12/2016 10:36 | |
hai dimenticato di allegare la funzione hpos
Hai ragione, scusatemi.Tra l'altro avevo anche pafsticcciato coi tag CODE.
Private Function HPos(H As Variant, Search As String) As Long
'cerca la stringa Search nell'array H,restituisce l'indice in H
Dim I As Long
HPos = -1 'se non trovo Searc in H, restituisco un valore di errore
If Search <> "" Then
For I = 0 To UBound(H)
If H(I) = Search Then
HPos = I
Exit Function
End If
Next I
End If
End Function
Public Sub Incolonna2()
Dim lRiga As LongPtr, rTabella As LongPtr, I As LongPtr, Last As LongPtr
Dim Elenco As Range, Tabella As Range
Dim Headers As Variant, nHeaders As Long, pHeader As Long
'==
Headers = Array("Nome", "Nascita:", "Ordine:", "Iscrizione:", "Sezione/Settore:" _
, "Altro:", "E-mail:", "Telefono:", "Fax:", "Indirizzo Studio:") 'array che contiene le nostre intestazioni per la tabella
nHeaders = UBound(Headers) + 1 'il n° delle intestazioni
Set Elenco = Range("A1")
Set Tabella = Range("D1")
For I = 1 To nHeaders 'scrivo le intestazioni
Tabella(1, I) = Headers(I - 1)
Next I
rTabella = 1 'posizione di riga all'interno della tabella
lRiga = 1 'posizione di riga all'interno dell'elenco
Last = Cells(Rows.Count, 1).End(xlUp).Row 'ultima riga dell'elenco
Do While lRiga < Last 'se non siamo a fine elenco
lRiga = lRiga + 1 'vediamo la riga successiva
If Elenco(lRiga, 1) = Headers(0) Then 'se trovo la stringa "Nome"
rTabella = rTabella + 1 'avanzo di una riga nella tabella
Tabella(rTabella, 1) = Elenco(lRiga, 2) 'scrivo il dato corrispondente
Else
pHeader = HPos(Headers, Elenco(lRiga, 1)) 'cerco la colonna della tabella
If pHeader > 0 Then 'se pHeader=-1 la cella è vuota, il caso pHeader=1(trattato precedentemente) può essere ignorato
Tabella(rTabella, pHeader + 1) = Elenco(lRiga, 2) 'scrivo il dato in tabella
End If
End If
Loop
Set Elenco = Nothing
Set Tabella = Nothing
End Sub
**EDIT**
Riguardo il funzionamento, il codice si limita ad usare le voci in colonna A e ne ricava la posizione di colonna relativa alla tabella.
Mi rendo conto che la sintassi usata per i range è un pò insolita, per es:
Tabella(rTabella, pHeader + 1) = Elenco(lRiga, 2)
equivale a scrivere
Tabella.Cells(rTabella, pHeader + 1) = Elenco.Cells(lRiga, 2)
Avrei dovuto commentare il codice, ma consideriamo che:
-a chi non è pratico di VBA i commenti non sarebbero utili
-chi è pratico di VBA non ha bisogno dei commenti
-sono moooolto PIGRO...
Scherzi a parte, avrei dovuto commentare il codice... [Modificato da Zer0kelvin 08/12/2016 11:25] __________________________
[Excel 2010]
-Condividere la conoscenza aumenta la ricchezza di tutti.
-Dai ad un uomo un pesce e lo avrai sfamato per un giorno; insegnagli a pescare e lo avrai sfamato per sempre. (Confucio)
-Il sonno della ragione genera mostri. (Francisco Goya) |
| | Post: 3.540 | Registrato il: 13/03/2012
| Città: LIVORNO | Età: 78 | Utente Master | 2010 | | OFFLINE | |
|
08/12/2016 11:03 | |
funziona perfettamente ed ha il vantaggio di essere universale, basta cambiare gli headers. [Modificato da patel45 08/12/2016 11:15]
----------
Win 10 - Excel 2010
allega un file di esempio, guadagnerai tempo tu e lo farai risparmiare a chi ti aiuta |
| | Post: 769 | Registrato il: 24/04/2004
| Città: TERAMO | Età: 63 | Utente Senior | 2010 | | OFFLINE |
|
08/12/2016 12:02 | |
Volendo esagerare, si potrebbero passare come parametri diversi dati: Elenco, Tabella, HEaders.
L'importante è che i dati di origine siano in due colonne adiacenti.
Con pochissime modifiche:
Public Sub Incolonna3(ByRef Elenco As Range, ByRef Tabella As Range, Headers As Variant)
Dim lRiga As LongPtr, rTabella As LongPtr, I As LongPtr, Last As LongPtr
Dim nHeaders As Long, pHeader As Long
'==
nHeaders = UBound(Headers) + 1 'il n° delle intestazioni
For I = 1 To nHeaders 'scrivo le intestazioni
Tabella(1, I) = Headers(I - 1)
Next I
rTabella = 1 'posizione di riga all'interno della tabella
lRiga = 1 'posizione di riga all'interno dell'elenco
Last = Cells(Rows.Count, 1).End(xlUp).Row 'ultima riga dell'elenco
Do While lRiga < Last 'se non siamo a fine elenco
lRiga = lRiga + 1 'vediamo la riga successiva
If Elenco(lRiga, 1) = Headers(0) Then 'se trovo la stringa "Nome"
rTabella = rTabella + 1 'avanzo di una riga nella tabella
Tabella(rTabella, 1) = Elenco(lRiga, 2) 'scrivo il dato corrispondente
Else
pHeader = HPos(Headers, Elenco(lRiga, 1)) 'cerco la colonna della tabella
If pHeader > 0 Then 'se pHeader=-1 la cella è vuota, il caso pHeader=1(trattato precedentemente) può essere ignorato
Tabella(rTabella, pHeader + 1) = Elenco(lRiga, 2) 'scrivo il dato in tabella
End If
End If
Loop
End Sub
Si presume che il primo indice di Headers sia zero.
SP: non testata.
[Modificato da Zer0kelvin 08/12/2016 12:15] __________________________
[Excel 2010]
-Condividere la conoscenza aumenta la ricchezza di tutti.
-Dai ad un uomo un pesce e lo avrai sfamato per un giorno; insegnagli a pescare e lo avrai sfamato per sempre. (Confucio)
-Il sonno della ragione genera mostri. (Francisco Goya) |
|
|