› Excel e gli applicativi Microsoft Office › Manipolazione dati e algoritmo per calcolo Stabilità
-
AutoreArticoli
-
Ciao a tutti.
Avrei bisogno di una mano per automatizzare la procedura per effettuare il calcolo di una variabile e dell'estrazione di alcuni dati da una serie storica di dati ambientali. Si tratta di profili verticali effettuati in mare mediante una sonda in determinati punti/stazioni e in determinate date, per cui per ogni stazione (in questo caso la stazione 604, vedi foglio "604_Profili") e per ogni data (dal 20/7/2015 al 2/10/2017) io ho dei valori per determinati parametri dell'acqua (colonne E-X "604_Profili"). Parte dei dati di ciascun profilo, per esempio quello effettuato in data 20/7/2015, debbono essere riportati, così come sono, in una tabella di sintesi (foglio "604_TabSint" riga 4); invece i due parametri Stabilità ("604_TabSint" col F) e ProfPicno ("604_TabSint" col G) debbono essere calcolati nel foglio "Calcolo_stabilità_sulla_colonna" utilizzando i dati dei parametri SampleDepth ("604_Profili", col. E) e Sigma_t ("604_Profili", col. F).
Vado al dunque. Un amico mi ha passato il file che vi allego in cui dovrei fare le seguenti operazioni:
1) Copiare i dati di profondità (E5:E17) e densità (F5:F17) di un profilo (il primo profilo è quello relativo alla data 20/7/2015) dal foglio "604_Profili" e incollarlo in H4 del foglio "Calcolo_stabilità_sulla_colonna".
2) Nel foglio "Calcolo_stabilità_sulla_colonna", come illustrato nella casella di testo, vengono calcolati attraverso una serie di passaggi (colonne A-G e J-T) la profondità del picnoclino e la stabilità del profilo (Q4 e T4).
3) Copio i valori del picnoclino e della stabilità del profilo (Q4 e T4) e li incollo rispettivamente nella cella G4 e F4 del foglio "604_TabSint".
4) Copio dal foglio "604_Profili" il valore dell'ossigeno (DO2_mg) corrispondente alla quota più profonda del transetto o, è lo stesso, all'ultimo valore del profilo (cella X17 = 3.93 corrispondente alla quota 11.58), e lo incollo nella corrispondente cella H4 del foglio"604_TabSint".
5) Copio dal foglio "604_Profili" il valore del Disco Secchi (Secchi Depth) del profilo (cella O5 = 6.2 e lo incollo nella corrispondente cella I4 del foglio"604_TabSint".
6) Copio dal foglio "604_Profili" i valori del range P5:U5 , corrispondenti alla quota più superficiale del profilo (0.5 m) e li incollo nel corrispondente range K4:P4 del foglio"604_TabSint"; copio il valore della quota (nel nostro caso 0.5 m; cella E5) associata a questi valori e lo incollo nella cella J4 del foglio"604_TabSint".
7) Copio dal foglio "604_Profili" i valori del range P17:U17 , corrispondenti alla quota più profonda del profilo o, comunque più profonda di quella superficiale ma meno della massima profondità del profilo (11.58 m; in altri profili, per esempio nel profilo del 5/11/2015 la seconda quota non coincide con la quota più profonda) e li incollo nel corrispondente range R4:W4 del foglio"604_TabSint"; copio il valore della quota (nel nostro caso 11.58 m; cella E17) associata a questi valori e lo incollo nella cella Q4 del foglio"604_TabSint".
Quanto fatto dal punto 1 al punto 7 debbo poi ripeterlo per tutti i profili fatti per la stazione "604" i cui dati sono nel foglio "604_Profili". A sua volta queste operazioni dovrei ripeterlo per circa 40 stazioni.
Nel file Test che vi allego vi sono solo i dati della stazione 604, ma io posso facilmente avere tutti i dati relativi a tutte le stazioni in unico foglio, inserendo il nome della stazione in una nuova colonna del foglio "604_Profili" oppure nella colonna A.
Il tempo necessario per fare questo credo sia molto lungo e, inoltre, si tratta di un lavoro molto noioso e ripetitivo che può indurre facilmente a fare errori. Per questo motivo volevo chiedere alla comunità se secondo voi è possibile scrivere una procedura in VBA per eseguire sia i calcoli che la trasposizione dei dati.
Io conosco poco il codice e credo che impiegherei molto tempo per implementare lo script in VBA. Se qualcuno potrebbe aiutarmi ne sarei molto grato.
Sono a disposizione per ulteriori informazioni.
Saluti
Allegati:
You must be logged in to view attached files.Ciao Leggendo velocemente mi sembrano tutte operazioni banali.
In VBA le automatizzi benissimo.
Se mastichi anche solo un poco di VBA puoi cominciare con il registrare una macro su una sequenza di dati e poi cercare di capire cosa modificare per rendrla "automatica"
Provaci e poi vediamo come aiutarti.
Ciao
Luca
La parte di trasferimento dei dati non credo sia difficile. E' la parte di calcolo della stabilità e profondità del picnoclino che vorrei convertire in una procedura VBA, credo sia un po' più complessa.
Comunque senza i dati i calcoli non li puoi fare, quindi una cosa alla volta.
Forse non sono stato chiaro nella spiegazione. Per il calcolo della stabilità e della profondità del picnoclino ho bisogno delle diverse quote in cui sono state fatte le misurazioni (Sample Depth) e dei valori di densità (sigma_t) per ciascuna quota, valori che ho di base.
Ciao.
innanzitutto qui ti possiamo dare un aiuto su excel e non su questioni tecniche. Cosa siano la stabilità e il picnoclino non sono prerogative di questo forum.
Riprendiamo la tua spiegazione e passiamola passo passo.
Punto 1) Copiare i dati di profondità (E5:E17) e densità (F5:F17) di un profilo (il primo profilo è quello relativo alla data 20/7/2015) dal foglio "604_Profili" e incollarlo in H4 del foglio "Calcolo_stabilità_sulla_colonna".
Traduzione per una macro: partre dalla cella E5 e selezionare tutti i valori a scendere fino a quando la relatica cella in colonna D è vuota (D18 non vuota: E17 ultima cella). al ciclo successivo dovrò partire dalla cella sottostante l'ultimo dato selezionato (E18) e poi scendere fino quando la relatica cella in colonna D è vuota.
Lo stesso vale per la colonna F (valori non formule da copiare)
Punto 2) Nel foglio "Calcolo_stabilità_sulla_colonna", come illustrato nella casella di testo, vengono calcolati attraverso una serie di passaggi (colonne A-G e J-T) la profondità del picnoclino e la stabilità del profilo (Q4 e T4).
Qui la situazione si fa più intricata in quanto ha asciato una parte delle speigazioni sul foglio.
Quello che non mi è chiaro e se una volta copiati i singoli valori dal foglio "604_Profili" al foglio "Calcolo_stabilità_sulla_colonna", bisogna fare qualcosa sui dati oppure il foglio fa tutte le operazion necessarie e devo solo prendere i risultati e portarli da un'altra parte. Così guardando il foglio mi sembra che tutte le celle siano formule pertanto mi aspetto che non ci sia da fare nulla.
Chiarito questo punto procediamo.
Ciao
Luca
E' chiaro; per la parte tecnica non chiedo nessun aiuto, essendo a me ben nota.
Hai ragione non sono stato abbastanza chiaro nella mia richiesta. Io vorrei tradurre tutto quello che faccio al momento manualmente in una procedura VBA che mi automatizzi tutto il processo descritto nei 7 punti. Per cui la routine VBA dovrebbe fare questo:
1) prendere i dati delle profondità (SampleDepth) e densità (Sigma_t) di un singolo profilo e, senza copiarli nel foglio "Calcolo_stabilità_sulla_colonna", caricarli in una matrice temporanea e calcolare il valore della stabilità e della profondità del picnoclino tramite un opportuno algoritmo che faccia quello che viene fatto dalle formule del foglio "Calcolo_stabilità_sulla_colonna".
Il resto dovrebbe essere più semplice perché implica solo la trasposizione di valori da una matrice ad un altra.
Spero di essere stato chiaro. Fammi sapere se hai bisogno di ulteriori informazioni.
Per esser stato chiaro, lo sei stato...
Ma almeno una struttura di Macro allegarla, no?
Ciao,
Arrivare a caricare i valori in una matrice dividendoli per giorni è "banale" la parte che devi spiegare "è calcolare il valore della stabilità e della profondità del picnoclino tramite un opportuno algoritmo che faccia quello che viene fatto dalle formule del foglio "Calcolo_stabilità_sulla_colonna"."
L'algoritmo lo implementi tu? se si allora per il resto comincia a registrare la macro se no devi spiegare gli algoritmi.
Naturalmente, non sapendo l'algoritmo non so neanche come dimensionare la matrice.
Quante colonne servono solo data profondità (SampleDepth) e densità (Sigma_t) o ne servono altre?
Ciao
Luca
Ciao.
Purtroppo anche io avevo capito come Luca73 (Ho lasciato le formule esistenti), anche se non mi era molto chiaro il punto 7, infatti il risultato dopo l'elaborazione e' leggermente diverso dall'originale.
Ormai ho fatto la routine e ti allego il file (Per adesso si ferma al primo profilo).
Si lancia con il pulsante Aggiorna nel foglio 604_Profili.
Allegati:
You must be logged in to view attached files.Ciao Aldo e grazie.
Ho eseguito la routine. Al momento si ferma al primo profilo. Va bene anche così senza eliminare i calcoli che attualmente vengono eseguiti da formule nel foglio "Calcolo..."; credo che implementarli nella routine richiederebbe molto lavoro, e visto che funziona possiamo lasciare tutto così.
E' possibile far eseguire la procedura per i tutti i profili presenti nel foglio "604_Profili" ?
Prima di processare il successivo profilo bisognerebbe cancellare nel foglio "Calcolo..." quello incollato precedentemente perché non sempre il profilo è formato dallo stesso numero di record e questo comporterebbe un errore nel calcolo
In questo modo la routine processerebbe tutti i profili di una stazione.
Nella colonna A del foglio "604_Profili" ho aggiunto il nome della stazione (vedi allegato); la routine, opportunamente modificata, potrebbe procedere a processare i profili di tutte le stazioni (circa 40-50) ?Sarebbe possibile mettere anche un controllo (una sorta di debug) che in caso di errore e di uscita mi indichi fino a quale profilo i dati erano formalmente corretti ? Forse questo sarebbe inutile perché la routine comunque processerebbe i profili e si fermerebbe solo quando troverebbe un errore formale o altro che ne blocca l'esecuzione.
Allegati:
You must be logged in to view attached files.Nel file allegato ho aggiunto due profili appartenenti alla stazione 2004.
In allegato il file con le implementazioni richieste da provare.
Ricordati che funzionera' "ESCLUSIVAMENTE" mantenendo lo schema attuale, cioe' se aggiungi/togli una colonna o cambi nome ai fogli non funzionera' piu'.
Ciao
Allegati:
You must be logged in to view attached files.Ciao
ho provato ad implementare il calcolo dei dati completamente in VBA
per favore prova a vedere se è tutto corretto
Sub ScriviDati() Dim FoglioOrig As Worksheet Dim FoglioDest As Worksheet Dim MiaCellaFO As Range Dim MiaCellaDest As Range Dim MioRangeFO As Range Dim VettoreR Dim Indice As Long Dim Finito As Boolean Dim Anno Dim Mese Set FoglioOrig = Sheets("604_Profili") Set FoglioDest = Sheets("604_TabSint") Finito = False FoglioDest.Range("A4", FoglioDest.Cells(Rows.Count, Columns.Count)).ClearContents Set MiaCellaFO = FoglioOrig.Range("D4") Do With FoglioOrig Set MiaCellaFO = MiaCellaFO.End(xlDown) If MiaCellaFO.End(xlDown).Row = Rows.Count Then Finito = True Set MioRangeFO = .Range(MiaCellaFO.Offset(0, 1), MiaCellaFO.Offset(0, 1).End(xlDown)).Offset(0, -1) Else Set MioRangeFO = .Range(MiaCellaFO, MiaCellaFO.End(xlDown).Offset(-1, 0)) End If 'MioRangeFO.Select Set MiaCellaDest = FoglioDest.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) For Indice = 1 To 4 Select Case Indice Case 1 MiaCellaDest.Offset(0, Indice - 1) = MiaCellaFO.Offset(0, Indice - 4) Case 2 If MiaCellaFO.Offset(0, Indice - 4) <> "" Then Anno = MiaCellaFO.Offset(0, Indice - 4) End If MiaCellaDest.Offset(0, Indice - 1) = Anno Case 3 If MiaCellaFO.Offset(0, Indice - 4) <> "" Then Mese = MiaCellaFO.Offset(0, Indice - 4) End If MiaCellaDest.Offset(0, Indice - 1) = Mese Case 4 MiaCellaDest.Offset(0, Indice - 1) = MiaCellaFO.Offset(0, Indice - 4) End Select Next VettoreR = Picnoclino(MioRangeFO.Offset(0, 1), MioRangeFO.Offset(0, 2)) MiaCellaDest.Offset(0, 5) = VettoreR(2) MiaCellaDest.Offset(0, 6) = VettoreR(1) MiaCellaDest.Offset(0, 4).FormulaR1C1 = "=DATE(RC[-3],RC[-2],RC[-1])" For Indice = 0 To 6 Intersect(MiaCellaDest.EntireRow, FoglioDest.Columns("K")).Offset(0, Indice) = Intersect(MioRangeFO(1).EntireRow, .Columns("p")).Offset(0, Indice) Intersect(MiaCellaDest.EntireRow, FoglioDest.Columns("R")).Offset(0, Indice) = Intersect(MioRangeFO(MioRangeFO.Count).EntireRow, .Columns("p")).Offset(0, Indice) Next Intersect(MiaCellaDest.EntireRow, FoglioDest.Columns("I")) = Intersect(MioRangeFO(1).EntireRow, .Columns("O")) Intersect(MiaCellaDest.EntireRow, FoglioDest.Columns("H")) = Intersect(MioRangeFO(MioRangeFO.Count).EntireRow, .Columns("X")) Intersect(MiaCellaDest.EntireRow, FoglioDest.Columns("J")) = Intersect(MioRangeFO(1).EntireRow, .Columns("E")) Intersect(MiaCellaDest.EntireRow, FoglioDest.Columns("Q")) = Intersect(MioRangeFO(MioRangeFO.Count).EntireRow, .Columns("E")) End With Loop While Not Finito End Sub Public Function Picnoclino(VettoreDepth, VettoreSigmaT) Dim PosDepth_B_1_2 Dim MaxDelta Dim ValoreMediaSigmaT Dim Depth_B(1 To 2) Dim MediaSigmaT_B(1 To 2) Dim Indice Dim Risultato(1 To 2) If VettoreDepth.Count <> VettoreSigmaT.Count Then Picnoclino = "Errore" Exit Function End If MaxDelta = 0 For Indice = 2 To VettoreDepth.Count If ((VettoreSigmaT(Indice) - VettoreSigmaT(Indice - 1)) > MaxDelta) Then MaxDelta = (VettoreSigmaT(Indice) - VettoreSigmaT(Indice - 1)) PosDepth_B_1_2 = Indice End If Next ValoreMediaSigmaT = 0 MediaSigmaT_B(1) = 0 MediaSigmaT_B(2) = 0 For Indice = 1 To VettoreSigmaT.Count ValoreMediaSigmaT = ValoreMediaSigmaT + VettoreSigmaT(Indice) If Indice <= PosDepth_B_1_2 Then MediaSigmaT_B(1) = MediaSigmaT_B(1) + VettoreSigmaT(Indice) End If If Indice >= PosDepth_B_1_2 Then MediaSigmaT_B(2) = MediaSigmaT_B(2) + VettoreSigmaT(Indice) End If Next ValoreMediaSigmaT = ValoreMediaSigmaT / VettoreSigmaT.Count Depth_B(1) = (VettoreDepth(1) + VettoreDepth(PosDepth_B_1_2)) / 2 Depth_B(2) = (VettoreDepth(VettoreDepth.Count) + VettoreDepth(PosDepth_B_1_2)) / 2 MediaSigmaT_B(1) = MediaSigmaT_B(1) / PosDepth_B_1_2 MediaSigmaT_B(2) = MediaSigmaT_B(2) / (VettoreSigmaT.Count - PosDepth_B_1_2 + 1) 'VettoreW = Application.Transition(VettoreDepth) Risultato(1) = 2 * Depth_B(1) - 1 Risultato(2) = 3600 / (2 * WorksheetFunction.Pi()) * Sqr((9.81 / (1000 + ValoreMediaSigmaT) * ((MediaSigmaT_B(2) - MediaSigmaT_B(1)) / (Depth_B(2) - Depth_B(1))))) Picnoclino = Risultato End Function
Vi ringrazio tutti per la disponibilità perché vedo che siamo a buon punto e rispondo a seguire sia a Aldo Ercolini che Luca73.
Innanzitutto invio una versione finale del file in cui ho fatto delle minime correzioni, lasciando invariati i nomi dei fogli e la struttura formale dei dati. Correzioni:
1) Ho inserito il nome della stazione nel foglio "604_Profili" nella colonna A (al posto del campo Id). Questo mi permetterà di processare con la routine VBA i profili di tutte le stazioni i cui dati avranno una struttura formale identica (stesso numero e disposizione dei parametri). Aldo ne è già a conoscenza. Quindi Luca73 dovresti implementare nella routine che in parte hai già scritto anche questa variabile. Nel passaggio da una stazione la struttura dei dati resta la stessa. La cosa che cambia è il numero di quote/record/righe che compongono il profilo. Il nome della stazione andrà poi riportato nella colonna A del foglio "604_TabSint".
2) Nel foglio "Calcolo..." mi sono accorto che erano state cancellate delle formule del parametro Delta_rho e precisamente quelle del range J17:J30. La loro mancanza sicuramente darebbe luogo ad errori nel computo della stabilità. Questa correzione interessa solamente Aldo che ha sviluppato una routine che sfrutta le formule presenti nel foglio per il calcolo della stabilità, visto che la routine di Luca73 dovrebbe invece farne a meno.
Se può facilitare la scrittura della routine, le righe vuote relative ai campi ANNO, MESE e GIORNO possono essere facilmente riempite con i rispettivi valori.
Ho provato la routine di Aldo e purtroppo genera degli errori per due motivi che ora descrivo e che possono aiutare anche Luca73 nello sviluppo della sua routine.
1) Nel trasferire i dati dal foglio "604_Profili" al foglio "604_TabSint", quelli relativi alla quota superficiale (0.5 m) sono copiati correttamente, mentre quelli relativi alla quota fondo (evidenziata in arancione) non sempre. Il motivo è che mentre i dati della quota superficiale è associata sempre alla quota 0.5 m, quelli associati alla quota fondo non sempre sono associati a quella più profonda. Il primo caso si osserva nel profilo del 5/11/2015, in cui i dati completi per tutti i parametri sono presenti solo per la quota 0.5 (riga 58) e 5 metri (riga 63). Purtroppo non c'è una regola o periodicità nella scelta della quota fondo; la cosa che è sicuro e che dopo i dati associati alla quota 0.5 esiste solo una quota più profonda con i dati dei parametri Orthophosphates (colonna P), DIN (Q), Total Phosphorus (R), Chlorophyll a (S), aDO2% (T) e TRIX (U).
2)
La routine scritta da Aldo non mi sembra che preveda la cancellazione dei dati incollati sotto i campi Depth (col H) e Sigma_t (col I) del foglio "Calcolo..." e copiati nel foglio "604_Profili. Quando passiamo ad un profilo successivo va tutto bene fin quando il profilo è costituito da un numero di record o quote =< di quello precedente. Quando invece viene incollato un profilo che contiene anche un solo record in meno rispetto al precedente, nei campi Depth e Sigma_t del foglio "Calcolo...", senza cancellare i dati precedenti delle colonne H ed I, rimane una riga in coda appartenente al profilo precedente che contribuisce al calcolo della stabilità che, quindi risulterà falsata.
Spero di essere stato chiaro nelle spiegazioni.
Aspetto vostri aggiornamenti.
Allegati:
You must be logged in to view attached files.Scusatemi, nell'ultimo paragrafo "=<" va sostituito con ">=", cioè maggiore o uguale.
Vi ringrazio di nuovo per il vostro aiuto.
Ciao Luca73.
La tua routine va benone ed è veloce, ad eccezione dei dati della Quota Fondo che mancano per alcuni profili; ma questo è dovuto al fatto che i dati associati a questa quota non sono sempre quelli della quota più profonda (come avviene per i primi profili). Il motivo è che mentre i dati della quota superficiale sono associati sempre alla quota 0.5 m, quelli associati alla quota fondo non sempre sono stati misurati a quella più profonda. Il primo caso si osserva nel profilo del 5/11/2015, in cui i dati completi per tutti i parametri sono presenti per la quota 0.5 (riga 58) e per la quota 5 metri (riga 63). Purtroppo non c'è una regola o periodicità nella scelta della quota fondo (in teoria ci sarebbe: dovrebbe essere la quota in cui si osserva il maggiore valore del parametro "Chlorophyll a"; però purtroppo questa regola non sempre è rispettata); la cosa sicura è che dopo i dati associati alla quota 0.5 esiste solo una quota più profonda (la seconda del profilo) con i dati dei parametri Orthophosphates (colonna P), DIN (Q), Total Phosphorus (R), Chlorophyll a (S), aDO2% (T) e TRIX (U).
Se puoi implementare nella tua routine questa pseudo-regola la routine è perfetta.
Un ultima cosa, dopo aver eseguito la routine nel foglio "604_TabSint" compaiono dei numeri nella colonna X per ciascun record di cui non riesco a capire l'origine.
Grazie mille per la disponibilità
Mi scuso per lo scarso apporto dato allo sviluppo della routine ma sono un biologo, per cui ho poca esperienza con i linguaggi di programmazione.
In verità sono curioso e disposto ad imparare a fare nuove cose, tra cui anche imparare a programmare; per cui ogni qual volta che si presenta qualche problema che richiede l'automatizzazione di procedure penso che è il momento di imparare un linguaggio di programmazione. Ora per esempio, ho deciso di iniziare a studiare R come linguaggio di script. In passato ho iniziato varie volte a studiare manuali di VBA e scrivere piccole routine, ma, essendo un'attività saltuaria (per anni poi non affronto problemi che richiedono la scrittura di programmi per automatizzare procedure) tutto quello che ho imparato sfuma.
Fammi sapere se è possibile quindi apportare questa correzione per la Quota Fondo.
Per i dati della Quota Fondo mi riferisco a quelli incollati nel foglio "604_TabSint".
Ciao,
ho fatto le correzioni da te giustamente richieste.
A me adesso sembra a posto.
Ho pero' notato che nel foglio "Calcolo_stabilita'_sulla_colonna" le formule della colonna J (Delta_rho) arrivano fino a 16 profondita" mentre alcuni profili arrivano anche a 30 profondita'.
Forse anche questo potrebbe influenzare i risultati finali.
Ciao.
Allegati:
You must be logged in to view attached files.Ora lo provo. Se hai utilizzato l'ultima versione del file che ho allegato il problema lo avevo risolto copiando e incollando le formule nel range in cui mancavano
Aldo
Ho provato la routine, dopo aver inserito le formule mancanti nella colonna J. Funziona alla grande. Manca un solo dato però. La colonna H del foglio "604_TabSint" che contiene i dati del parametro "DO2fondo" risulta vuota; questa colonna dovrebbe essere popolata dal valore del parametro "DO2mg" (colonna X) del foglio "604_Profili" corrispondente alla quota più profonda di ciascun profilo. Per esempio, per il profilo della stazione 604 eseguito in data 20/7/2015 il valore di "DO2mg" è 3.93 (cella X17), per il profilo della stazione 604 eseguito in data 3/8/2015 il valore di "DO2mg" è 3.17 (cella X30), e così di seguito.
Puoi implementare quest'ultimo dato per piacere ?
Grazie e buon week end
Vi ringrazio e vi chiedo se possibile, anche più in là, se potete aggiungere qualche commento alla routine (semmai alle parti più complesse) così se debbo modificarla o adattarla in altri contesti posso provare a farlo io.
Ciao,
Fatto
Buon fine settimana anche a te.
P.s.: Anhe su questo file devi inserire le formule nella colonna J
Allegati:
You must be logged in to view attached files.Ciao Ho modificato la mia routine per la quota fondo con valori vuoti.
Guarda per favore se la nuova è corretta.
Ti riallego solo la routine modificata.
Ciao
Luca
Option Explicit Sub ScriviDati() Dim FoglioOrig As Worksheet Dim FoglioDest As Worksheet Dim MiaCellaFO As Range Dim MiaCellaDest As Range Dim MioRangeFO As Range Dim VettoreR Dim Indice As Long Dim Finito As Boolean Dim Anno Dim Mese Dim OffMio Set FoglioOrig = Sheets("604_Profili") Set FoglioDest = Sheets("604_TabSint") Finito = False FoglioDest.Range("A4", FoglioDest.Cells(Rows.Count, Columns.Count)).ClearContents Set MiaCellaFO = FoglioOrig.Range("D4") Do With FoglioOrig Set MiaCellaFO = MiaCellaFO.End(xlDown) If MiaCellaFO.End(xlDown).Row = Rows.Count Then Finito = True Set MioRangeFO = .Range(MiaCellaFO.Offset(0, 1), MiaCellaFO.Offset(0, 1).End(xlDown)).Offset(0, -1) Else Set MioRangeFO = .Range(MiaCellaFO, MiaCellaFO.End(xlDown).Offset(-1, 0)) End If 'MioRangeFO.Select Set MiaCellaDest = FoglioDest.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) For Indice = 1 To 4 Select Case Indice Case 1 MiaCellaDest.Offset(0, Indice - 1) = MiaCellaFO.Offset(0, Indice - 4) Case 2 If MiaCellaFO.Offset(0, Indice - 4) <> "" Then Anno = MiaCellaFO.Offset(0, Indice - 4) End If MiaCellaDest.Offset(0, Indice - 1) = Anno Case 3 If MiaCellaFO.Offset(0, Indice - 4) <> "" Then Mese = MiaCellaFO.Offset(0, Indice - 4) End If MiaCellaDest.Offset(0, Indice - 1) = Mese Case 4 MiaCellaDest.Offset(0, Indice - 1) = MiaCellaFO.Offset(0, Indice - 4) End Select Next VettoreR = Picnoclino(MioRangeFO.Offset(0, 1), MioRangeFO.Offset(0, 2)) MiaCellaDest.Offset(0, 5) = VettoreR(2) MiaCellaDest.Offset(0, 6) = VettoreR(1) MiaCellaDest.Offset(0, 4).FormulaR1C1 = "=DATE(RC[-3],RC[-2],RC[-1])" If Intersect(MioRangeFO(MioRangeFO.Count).EntireRow, .Columns("p")) = "" Then OffMio = Intersect(MioRangeFO(MioRangeFO.Count).EntireRow, .Columns("p")).End(xlUp).Row - Intersect(MioRangeFO(MioRangeFO.Count).EntireRow, .Columns("p")).Row Else OffMio = 0 End If For Indice = 0 To 6 Intersect(MiaCellaDest.EntireRow, FoglioDest.Columns("K")).Offset(0, Indice) = Intersect(MioRangeFO(1).EntireRow, .Columns("p")).Offset(0, Indice) Intersect(MiaCellaDest.EntireRow, FoglioDest.Columns("R")).Offset(0, Indice) = Intersect(MioRangeFO(MioRangeFO.Count).EntireRow, .Columns("p")).Offset(OffMio, Indice) Next Intersect(MiaCellaDest.EntireRow, FoglioDest.Columns("I")) = Intersect(MioRangeFO(1).EntireRow, .Columns("O")) Intersect(MiaCellaDest.EntireRow, FoglioDest.Columns("H")) = Intersect(MioRangeFO(MioRangeFO.Count).EntireRow, .Columns("X")) Intersect(MiaCellaDest.EntireRow, FoglioDest.Columns("J")) = Intersect(MioRangeFO(1).EntireRow, .Columns("E")) Intersect(MiaCellaDest.EntireRow, FoglioDest.Columns("Q")) = Intersect(MioRangeFO(MioRangeFO.Count).EntireRow, .Columns("E")).Offset(OffMio, 0) End With Loop While Not Finito End Sub
-
AutoreArticoli