[EXCEL] Macro trasponi

[ramset64]

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!

[Anthony47]

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.

[ramset64]

Si è vero ma poi quando i dati diventano tanti le formule incominciano a pesare mentre con una macro i file sono più piccoli.

[Anthony47]

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.

[ramset64]

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

[Anthony47]

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.

[ramset64]

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

[Anthony47]

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.

[ramset64]

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

[ramset64]

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

[Anthony47]

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

Ciao.

[ramset64]

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]

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

[Anthony47]

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

Ciao.

[ramset64]

Ti ringrazio.
Ciao

[Anthony47]

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.

[ramset64]

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.

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

[Anthony47]

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.

[ramset64]

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

[Anthony47]

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.