Condividi:        

[EXCEL] Macro trasponi

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

[EXCEL] Macro trasponi

Postdi ramset64 » 14/12/08 11:21

Nel foglio allegato vi sono delle quotazioni nel formato classico, io vorrei avere nel secondo foglio gli stessi dati ma in forma diversa ovvero incolonnati per orario. Nel foglio vi è anche la macro per fare ciò che funziona correttamente su altri file che hanno data e ora nella stessa cella mentre questo ha la data in una cella e l'ora nell'altra. Sarebbe in pratica da effettuare una piccola modifica alla macro già presente.
Grazie dell'aiuto!
Allegati

[L’estensione rar è stata disattivata e non puó essere visualizzata.]

ramset64
Utente Senior
 
Post: 396
Iscritto il: 29/10/08 10:41
Località: Torino

Sponsor
 

Re: [EXCEL] Macro trasponi

Postdi Anthony47 » 14/12/08 18:13

Non hai bisogno di una macro per fare questo, basta una formula con cerca.verticale; es in C2 di Incolonnati, per tovare il valore di open userai la formula
Codice: Seleziona tutto
=CERCA.VERT(C$1;Originali!$B:$C;2;0)

Poi copi C2 su D2 e oltre.
Se vuoi riportare il valore "h", ad esempio in C3, usi la stessa formula modificando l' indice da "2" a "3"; e cosi' via incrementando per le altre colonne di Originali che ti interessano.

Ciao.
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [EXCEL] Macro trasponi

Postdi ramset64 » 14/12/08 18:39

Si è vero ma poi quando i dati diventano tanti le formule incominciano a pesare mentre con una macro i file sono più piccoli.
ramset64
Utente Senior
 
Post: 396
Iscritto il: 29/10/08 10:41
Località: Torino

Re: [EXCEL] Macro trasponi

Postdi Anthony47 » 15/12/08 02:29

Ma con le formule sei autonomo, con le macro no (non mi pare).

Cio' detto:
Codice: Seleziona tutto
Sub trasp()
SSh = "Originali": DSh = "Incolonnati"
TCol = 5      'N° di colonne da trasporre
Worksheets(SSh).Activate
For I = 0 To TCol - 1
 Range("A1").Offset(0, I).Copy Destination:=Sheets(DSh).Range("B1").Offset(I, 0)
Next I
serNum = Range("A2").Value: I = 0
Do
I = I + 1
If Range("A1").Offset(I, 0) > serNum Then GoTo Exita
For J = 0 To TCol - 1
 Range("B1").Offset(I, J).Copy Destination:=Sheets(DSh).Range("B1").Offset(J, I)
Next J
Loop
Exita:
End Sub


Ciao.
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [EXCEL] Macro trasponi

Postdi ramset64 » 15/12/08 17:42

Grazie Anthony ma la macro fa solo parzialmente quello che mi serve.
La macro da me postata invece, copiava tutto il contenuto del foglio originale e li riportava nel foglio incolonnati in modo corretto, successivamente se veniva aggiunti dati e lanciata la macro aggiornava solo i nuovi dati.

Hai ragione con le formule più o meno sono autonomo con le macro no. Ma se fossi autonomi cosa posterei a fare ?
Saluti
ramset64
Utente Senior
 
Post: 396
Iscritto il: 29/10/08 10:41
Località: Torino

Re: [EXCEL] Macro trasponi

Postdi Anthony47 » 16/12/08 00:07

Non ho la pazienza, ne' il tempo, per fare il reverse engineering del codice e dedurre da questo quale e' la richiesta.
La macro che ti ho dato sposta in orizzontale solo un giorno dell' elenco; quale e' invece la richiesta? Poi, i dati in origine con che frequenza vengono aggiornati, idem come preferenza per la rielaborazione dei dati in output.
Mi pare comunque che intendi trasformare l' elenco attuale in "sandwich": sei sicuro della loro fruibilita'?

Hai ragione con le formule più o meno sono autonomo con le macro no. Ma se fossi autonomi cosa posterei a fare ?
Ad esempio per chiedere suggerimenti, non soluzioni usa e getta.

Ciao.
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [EXCEL] Macro trasponi

Postdi ramset64 » 20/12/08 18:23

Scusami Anthony, ma davvero con le formule è un discorso che non si può fare, ci vorrebbero decine di minuti solo per aprire i file.

Cerco di spiegare nel miglior modo possibile ciò che mi serve, se poi tu o qualche altra persona capace vuole darmi una mano bene altrimenti non importa, capisco che il tempo è tiranno e ti assicuro che per me questa non è una soluzione usa e getta ma una necessità.

Nel foglio1 vi sono dei dati accodati per ordine cronologico.
Nel foglio2 vorrei ottenere i dati incolonnati come da esempio sulla riga2.

Vi sarebbero però alcune accortezze da utilizzare:
1) Nel foglio1 la data è settata come testo (e come tale deve restare altrimenti risolvo un problema e ne creo un altro), cosi come le colonne utilizzate devo restare come sono. Nel foglio2 invece la data può essere settata sia come testo sia come data non è importante.
2) I dati presenti nel foglio1 possono variare in lunghezza (nel file allegato sono 18 righe per data ma potrebbero essere di più o di meno a seconda dello strumento).
3) Quando la macro viene lanciata deve aggiornare solo i dati mancanti (e non riscrivere tutti i dati dall'inizio).

Che possiate darmi una mano o meno ringrazio tutti l'aiuto finora dato ed in particolare Anthony.

Ciao
Allegati

[L’estensione rar è stata disattivata e non puó essere visualizzata.]

ramset64
Utente Senior
 
Post: 396
Iscritto il: 29/10/08 10:41
Località: Torino

Re: [EXCEL] Macro trasponi

Postdi Anthony47 » 20/12/08 18:45

Per quanto riguarda il termine "usa e getta" e' riferito al fatto che la soluzione che ti do' tu non la potrai adattare a bisogni futuri.

L' esempio che posti non mi dice come vuoi i dati su foglio2; puoi fare un esempio piu' generoso (basta uno schizzo che vada oltre il primo giorno)?
Confermi poi che il numero di righe per giorno rimane costante, come pure lo split orario? o ogni giorno raccogli dati con frequenza e granularita' sempre diversa?

Ciao.
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [EXCEL] Macro trasponi

Postdi ramset64 » 20/12/08 18:52

Confermo tutto, eventuali ammanchi nei dati vengono corretti manualmente, quindi ogni giorno ha sempre lo stesso numero di righe.
Allego nuovamente il file con l'aggiunta di altre 2 righe sul foglio2.

Grazie
Allegati

[L’estensione rar è stata disattivata e non puó essere visualizzata.]

ramset64
Utente Senior
 
Post: 396
Iscritto il: 29/10/08 10:41
Località: Torino

Re: [EXCEL] Macro trasponi

Postdi ramset64 » 20/12/08 18:55

Anthony47 ha scritto:Per quanto riguarda il termine "usa e getta" e' riferito al fatto che la soluzione che ti do' tu non la potrai adattare a bisogni futuri.

Dimenticavo.... no Anthony questo non è vero, cerco sempre di prendere spunto da qualcosa che ho già per bisogni futuri, almeno ci provo. Grazie.

Ciao
ramset64
Utente Senior
 
Post: 396
Iscritto il: 29/10/08 10:41
Località: Torino

Re: [EXCEL] Macro trasponi

Postdi Anthony47 » 20/12/08 19:07

Ma allora le altre colonne (h-l-cl) vanno ignorate?

Ciao.
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [EXCEL] Macro trasponi

Postdi ramset64 » 20/12/08 19:17

Anthony47 ha scritto:Ma allora le altre colonne (h-l-cl) vanno ignorate?

Ciao.

Ma certo che no.... :) ricapitoliamo.
Nel foglio2 in ordine di colonna vanno inseriti, giorno 1:
Data, Open (primo valore della colonna o, a seguire tutti i valori di chiusura (quindi tutti i valori della colonna cl), poi il valore massimo relativo alla data presente nella colonna h (quindi il massimo di giornata), il valore minimo della colonna l (quindi il minimo di giornata).
Grazie, ciao
ramset64
Utente Senior
 
Post: 396
Iscritto il: 29/10/08 10:41
Località: Torino

Re: [EXCEL] Macro trasponi

Postdi ramset64 » 20/12/08 19:22

Anthony allego nuovamente il file dove ho evidenziato con i colori la destinazione che devono avere i dati.
Dovrebbe essere più chiaro.
Ciao
Allegati

[L’estensione rar è stata disattivata e non puó essere visualizzata.]

ramset64
Utente Senior
 
Post: 396
Iscritto il: 29/10/08 10:41
Località: Torino

Re: [EXCEL] Macro trasponi

Postdi Anthony47 » 20/12/08 19:33

Prendo per buono quest' ultimo esempio e ignoro tutte le descrizioni precedenti. Comunque ci meditero' sopra piu' tardi...

Ciao.
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [EXCEL] Macro trasponi

Postdi ramset64 » 20/12/08 23:36

Ti ringrazio.
Ciao
ramset64
Utente Senior
 
Post: 396
Iscritto il: 29/10/08 10:41
Località: Torino

Re: [EXCEL] Macro trasponi

Postdi Anthony47 » 21/12/08 16:35

Prova le seguente macro:
Codice: Seleziona tutto
Sub TraspRude()
'Non cerca di accodare i nuovi dati, ma ripete dall' inizio
SSh = "Foglio1": DSh = "Foglio2"        '<<<Foglio Sorgente e Foglio di destinazione
DRoot = "F1"                            '<<<Radice dei dati da elaborare
'
Worksheets(SSh).Activate
'[A1] = Timer
'Mette le intestazioni su Destination
Sheets(DSh).Range("A1").Value = "Data": Sheets(DSh).Range("B1").Value = "Open"
For I = 1 To 1000
If Range(DRoot).Offset(I, 1).Value < CurT Then Exit For
CurT = Range(DRoot).Offset(I, 1).Value
Sheets(DSh).Range("B1").Offset(0, I).Value = CurT
Next I
Sheets(DSh).Range("B1").Offset(0, I).Value = "DayMax"
Sheets(DSh).Range("B1").Offset(0, I + 1).Value = "DayMin"
Sheets(DSh).Range("A2", Sheets(DSh).Cells(Rows.Count, I + 4)).Clear
Application.ScreenUpdating = False
'
'Traspone e Accoda i dati
Range(DRoot).Select
'Prima riga di nuova data
Selection.Offset(1, 0).Select
ReData:
 If CMax > 0 Then Sheets(DSh).Cells(Rows.Count, 1).End(xlUp).Offset(0, I + 2).Value = CMax
 If CMin > 0 Then Sheets(DSh).Cells(Rows.Count, 1).End(xlUp).Offset(0, I + 3).Value = CMin
If ActiveCell.Value = "" Then GoTo Exitb
Cdata = ActiveCell.Value
Sheets(DSh).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Cdata
Selection.Offset(0, 2).Copy Destination:=Sheets(DSh).Cells(Rows.Count, 1).End(xlUp).Offset(0, 1)
CMax = 0: CMin = 999999
'
For I = 0 To 1440         'Scansione righe
If ActiveCell.Value <> Cdata Then GoTo ReData   'Ritorna a Prima Riga di nuova data
'Calcola Min e Max
If Selection.Offset(0, 3).Value > CMax Then CMax = Selection.Offset(0, 3).Value
If Selection.Offset(0, 4).Value < CMin Then CMin = Selection.Offset(0, 4).Value
'Posiziona Open di orario
Selection.Offset(0, 5).Copy Destination:=Sheets(DSh).Cells(Rows.Count, 1).End(xlUp).Offset(0, I + 2)
Selection.Offset(1, 0).Select    'Next riga
Next I
'
Exitb:
Application.ScreenUpdating = True
'[A2] = Timer
End Sub

Guarda le due istruzioni marcate <<<, compilate secondo l' ultimo esempio postato; eventualmente correggi per riflettere la tua situazione, in particolare DRoot e' la cella dell' intestazione di data.

La macro AZZERA il foglio di destinazione, poi lo intesta ed elabora tutti i dati presenti nel foglio sorgente.
Rispetto ai tuoi desideri ho ignorato la richiesta di elaborare solo i dati non ancora trasposti nel secondo foglio; cioe' la macro elabora dall' inizio tutte le volte che la rilanci. Essa elabora un anno di dati in circa 4.25 secondi (circa 26 secondi per 33000 linee su un pc non particolarmente performante), quindi l' appesantimento mi sembra trascurabile.

Prova e fai sapere.
Ciao.
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [EXCEL] Macro trasponi

Postdi ramset64 » 21/12/08 18:00

Anthony ho provato sia pure velocemente la tua macro e direi che va anche oltre i miei desideri (vedi intestazione). Sinceramente non so come ringraziarti, tuttavia il problema non è risolto.

Anthony47 ha scritto:Rispetto ai tuoi desideri ho ignorato la richiesta di elaborare solo i dati non ancora trasposti nel secondo foglio; cioe' la macro elabora dall' inizio tutte le volte che la rilanci. Essa elabora un anno di dati in circa 4.25 secondi (circa 26 secondi per 33000 linee su un pc non particolarmente performante), quindi l' appesantimento mi sembra trascurabile.

L'appesantimento purtroppo non è trascurabile, ci sono file che hanno 3-400.000 righe, l'esempio postato ha un timeframe a 30 minuti ma ho file anche da 5 minuti. Aggiungi che i file sono tanti e quindi ci vorrebbero ore ogni qualvolta si fa un aggiornamento.
Elaborare solo i dati non ancora trasposti nel secondo foglio è una necessità primaria.
Ora bisogna vedere perchè hai deciso di non inserirlo, se è solo perchè pensavi fosse trascurabile magari si può rimediare altrimenti è un problema.
In ogni caso ti ringrazio tantissimo, ti deve essere costato molto tempo realizzare la macro.
Ciao
ramset64
Utente Senior
 
Post: 396
Iscritto il: 29/10/08 10:41
Località: Torino

Re: [EXCEL] Macro trasponi

Postdi Anthony47 » 22/12/08 00:00

Ho skippato l' accodamento perche' trovo pericoloso lavorare con una struttura dati che si fa fatica a garantire che rimanga la stessa; non e' difficile, l' avevo gia' abbozzata cosi' ma poi ho cambiato idea.
"Forse" piu' tardi la posso riprendere...

Ciao.
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [EXCEL] Macro trasponi

Postdi ramset64 » 22/12/08 02:03

Anthony47 ha scritto:Ho skippato l' accodamento perche' trovo pericoloso lavorare con una struttura dati che si fa fatica a garantire che rimanga la stessa; non e' difficile, l' avevo gia' abbozzata cosi' ma poi ho cambiato idea.
"Forse" piu' tardi la posso riprendere...

Ciao.

Anthony mi faresti una grande cortesia se la riprendi.
Grazie
Ciao
ramset64
Utente Senior
 
Post: 396
Iscritto il: 29/10/08 10:41
Località: Torino

Re: [EXCEL] Macro trasponi

Postdi Anthony47 » 24/12/08 02:21

Allora, prova a usare questo codice:
Codice: Seleziona tutto
Dim TrDate
Dim DRoot As String
Dim SSh As String, DSh As String
'
Sub TraspRude()
'vedi
'Non cerca di accodare i nuovi dati, ma ripete dall' inizio
'SSh = "Foglio1": DSh = "Foglio2"        '<<<Foglio Sorgente e Foglio di destinazione
'DRoot = "F1"                            '<<<Radice dei dati da elaborare   -Eredita da caller
'
If Range(DRoot).Row > 1 Then GoTo Queue
Worksheets(DSh).Activate
Rispo = MsgBox("Posso cancellare tutto il contenuto del foglio " & vbCrLf & "per creare il riepilogo da zero?", vbYesNo)
   If Rispo = vbNo Then GoTo Exitb
Worksheets(SSh).Activate
'Mette le intestazioni su Destination
Sheets(DSh).Range("A1").Value = "Data": Sheets(DSh).Range("B1").Value = "Open"
For I = 1 To 1000
If Range(DRoot).Offset(I, 1).Value < CurT Then Exit For
CurT = Range(DRoot).Offset(I, 1).Value
Sheets(DSh).Range("B1").Offset(0, I).Value = CurT
Next I
Sheets(DSh).Range("B1").Offset(0, I).Value = "DayMax"
Sheets(DSh).Range("B1").Offset(0, I + 1).Value = "DayMin"
Sheets(DSh).Range("A2", Sheets(DSh).Cells(Rows.Count, I + 4)).Clear
'Application.ScreenUpdating = False
'
Queue:
'Traspone e Accoda i dati
Range(DRoot).Select
'[A1] = Timer
Application.ScreenUpdating = False
'Prima riga di nuova data
Selection.Offset(1, 0).Select
ReData:
 If CMax > 0 Then Sheets(DSh).Cells(Rows.Count, 1).End(xlUp).Offset(0, I + 2).Value = CMax
 If CMin > 0 Then Sheets(DSh).Cells(Rows.Count, 1).End(xlUp).Offset(0, I + 3).Value = CMin
If ActiveCell.Value = "" Then GoTo Exitb
Cdata = ActiveCell.Value
Sheets(DSh).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Cdata
Selection.Offset(0, 2).Copy Destination:=Sheets(DSh).Cells(Rows.Count, 1).End(xlUp).Offset(0, 1)
CMax = 0: CMin = 999999
'
For I = 0 To 1440         'Scansione righe
If ActiveCell.Value <> Cdata Then GoTo ReData   'Ritorna a Prima Riga di nuova data
'Calcola Min e Max
If Selection.Offset(0, 3).Value > CMax Then CMax = Selection.Offset(0, 3).Value
If Selection.Offset(0, 4).Value < CMin Then CMin = Selection.Offset(0, 4).Value
'Posiziona Open di orario
Selection.Offset(0, 5).Copy Destination:=Sheets(DSh).Cells(Rows.Count, 1).End(xlUp).Offset(0, I + 2)
Selection.Offset(1, 0).Select    'Next riga
Next I
'
Exitb:
Sheets(SSh).Select
Application.ScreenUpdating = True
'[A2] = Timer
End Sub
'   
'
Sub StarTrasp()
'
'Vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=77177
'
SSh = "Foglio1": DSh = "Foglio2"        '<<< Foglio Sorgente e Foglio di destinazione
DRoot = "F1"                            '<<< Radice dei dati
'
Sheets(SSh).Select
Range(DRoot).Select
If Sheets(DSh).Cells(Rows.Count, 1).End(xlUp).Row > 1 Then
 LaData = Format(Sheets(DSh).Cells(Rows.Count, 1).End(xlUp).Value, "mm/dd/yyyy")
 Range(DRoot).EntireColumn.Select

'Controlla se la stringa di "ultima data" su foglio2 esiste nell' elenco
If Selection.Find(What:=LaData, After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False) Is Nothing Then
    MsgBox ("Ho cercato in colonna " & DRoot & vbCrLf & _
      "la stringa " & LaData & " senza trovarla" & vbCrLf & _
      "La trasposizione e' abortita")
    Exit Sub
    End If
'Attivala e cerca l' ultima occorrenza
    Selection.Find(What:=LaData, After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
TrLaData:
 If ActiveCell.Offset(1, 0).Value = LaData Then ActiveCell.Offset(1, 0).Select: GoTo TrLaData
'Comincia da questo indirizzo
 DRoot = ActiveCell.Address
 End If
Call TraspRude
End Sub

E' fatta da due macro:
-la prima (TraspRude) e' praticamente quella che ti avevo gia' proposto salvo l' aggiunta di un messaggio nel caso che si cerca di cancellare i dati gia' trasposti
-la seconda /StarTrasp) e' quella da lanciare, che verifica la presenza di dati su Foglio2 (o come lo hai definito) e chiama TraspRude in modalita' "accoda" (dati gia' presenti in Foglio2) e "ex-novo" (dati non presenti in Foglio2).

La macro TraspRude non la devi piu' lanciare, anche se lanciarla non e' distruttivo perche' o parte in accodamento oppure ti chiede se vuoi cancellare Foglio2, dove ovviamente risponderai di No.

Come sempre, due copie di backup dei tuoi dati prima di qualsiasi elaborazione.

Ciao.
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Prossimo

Torna a Applicazioni Office Windows


Topic correlati a "[EXCEL] Macro trasponi":


Chi c’è in linea

Visitano il forum: Nessuno e 58 ospiti