Previous page | 1 | Next page
Facebook  

Riepilogo per continuità date

Last Update: 10/17/2020 6:47 AM
Author
Print | Email Notification    
Post: 3,002
Registered in: 4/6/2013
Location: ROMA
Age: 73
Master User
2010
OFFLINE
10/15/2020 11:20 AM
 
Modify
 
Delete
 
Quote

Ciao a tutti
avrei bisogno di un suggerimento su come impostare una macro per ottenere un riepilogo meglio esposto nell'allegato.

Come potrete rilevare, ho una serie di nominativi, periodo dal..al... e causali da col. A a D.
L'elenco è già ordinato per nominativo e data Dal...

Dovrei ottenere un riepilogo per singolo nominativo, con affianco i periodi dal...al... se continuativi e se con la medesima causale.

ES: nome_1
non avendo ulteriori ricorrenze, riporto da J2 in orizzontale i dati così come sono.

ES: nome_2
il nominativo presenta 4 righe
poichè le prime due presentano un periodo continuativo dal 20/03 in B3 al 29/03 in C4 ed hanno la medesima causale (AA) riporto da J3 in poi il periodo continuativo e la causale:
J3 in poi: nome_2 20/03/2020 29/03/2020 AA

La terza ricorrenza di nome_2 (benchè coninuativa nel periodo) presenta una causale diversa e pertanto va riportata separatamente sempre in linea con il nominativo.
La quarta ricorrenza ha la stessa causale ma NON presenta cononuit5à con la precedente e pertanto anche questa va riportata a parte.

Spero che dall'esempio sia più chiaro.

Grazie per l'aiuto



Domenico
Win 10 - Excel 2016
Post: 839
Registered in: 6/24/2015
Location: CATANIA
Age: 76
Senior User
Excel2010
OFFLINE
10/15/2020 5:04 PM
 
Modify
 
Delete
 
Quote

Ciao Domenico
Ti allego quello che sono riuscito a fare fino adesso.
So benissimo che non è quello che ti aspetti ma c'è qualcosa che m'ingrippa e non riesco a sbrogliare la matassa.
Fra l'altro la moglie reclama per uscire.
Potrò ridedicarmici stasera.

Intanto vedi se trovi qualcuno dei miei tanti errori (prova la macro su una copia del tuo elaborato).

Ciao,
Mario

Questa la macro che sto elaborando
 
 
Sub Riepilogo()

ur = Cells(Rows.Count, 1).End(xlUp).Row
Range("F:Z").ClearContents
rg = 2: cn = 6
'cicla per col.A
For i = 2 To ur
uno = Cells(i, 1).Value 'nominativo
datini = Cells(i, 2).Value 'data inizio
datfin = Cells(i, 3).Value 'data fine
caus = Cells(i, 4).Value 'causale
For j = i + 1 To ur
due = Cells(j, 1).Value 'nominativo
If uno = due Then 'se uguali
If caus = Cells(j, 4).Value Then 'se le due causali sono uguali
datfin = Cells(j, 3).Value 'memorizza NUOVA data fine
Stop
GoTo ripeti
ElseIf caus <> Cells(j, 4) Then 'se le due causali sono diverse
Stop
'scrive i dati memorizzati
Cells(rg, 6) = uno
Cells(rg, cn + 1) = datini
Cells(rg, cn + 2) = datfin
Cells(rg, cn + 3) = caus
Stop
i = j - 1
cn = cn + 3 'incrementa colonna
GoTo salta
End If
ElseIf uno <> due Then
Stop
'scrive i dati memorizzati
Cells(rg, 6) = uno
Cells(rg, cn + 1) = datini
Cells(rg, cn + 2) = datfin
Cells(rg, cn + 3) = caus
rg = rg + 1
cn = 6
Exit For
End If
ripeti:
Next j
salta:
Next i
Stop
End Sub

Post: 3,002
Registered in: 4/6/2013
Location: ROMA
Age: 73
Master User
2010
OFFLINE
10/15/2020 5:12 PM
 
Modify
 
Delete
 
Quote

grazie Mario
ci sto battendo anche io la testa....forse qualcosa ho trovato.

In merito al tuo lavoro c'è un problema relativo al fatto che nel riepilogo non ci devono essere nominativi ripetuti, ma tutto su una riga.

Grazie ancora per il tuo interessamento.

cari saluti



Domenico
Win 10 - Excel 2016
Post: 6,104
Registered in: 11/14/2004
Master User
Office 2019
ONLINE
10/15/2020 5:31 PM
 
Modify
 
Delete
 
Quote

Ciao vedo se riesco a trovare anchio qualcosa.

Ciao Salvatore
se ti piace la soluzione aiuta a sostenere il Forum con una DONAZIONE a piacere, Grazie





Iscriviti al nuovo sito che ho aperto troverai altre RISPOSTE
https://www.bysal-excel.it
Post: 3,003
Registered in: 4/6/2013
Location: ROMA
Age: 73
Master User
2010
OFFLINE
10/15/2020 6:22 PM
 
Modify
 
Delete
 
Quote

ciao e grazie a tutti

"mi sembra" di aver prodotto un risultato anche se mi sono avvalso di un foglio di appoggio (work) e di un altro per il riepilog (Riepilogo).

In una prima fase vengono copiati i dati in work (tutti) ed in Riepilogo, ma in modo univoco affiancando tutte le date.
(Devo farlo così per motivi che non sto qui a spiegare)

Poi in Riepilogo leggo sequenzialmente in orizzontale le colonne a gruppi di date/causale e, nel caso, faccio i dovuti aggiornamenti cancellando quello già valutato. (difficile da spiegare)

Non ho trovato metodo più snello.

saluti

(allego file se qualcuno interessato)





Domenico
Win 10 - Excel 2016
Post: 840
Registered in: 6/24/2015
Location: CATANIA
Age: 76
Senior User
Excel2010
OFFLINE
10/15/2020 9:53 PM
 
Modify
 
Delete
 
Quote

Ciao Domenico
Ho rielaborato la macro alla quale ho aggiunto una Function.
Il codice è il seguente
 
Sub Riepilogo()
ur = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(ur, 1) = "*"
Range("F:Z").ClearContents
rg = 2: cn = 6
'cicla per col.A
For i = 2 To ur
uno = Cells(i, 1).Value 'nominativo
datini = Cells(i, 2).Value 'data inizio
datfin = Cells(i, 3).Value 'data fine
caus = Cells(i, 4).Value 'causale
For j = i + 1 To ur
due = Cells(j, 1).Value 'nominativo
If uno <> due Then
'scrive i dati memorizzati
x = Dati(rg, cn, uno, datini, datfin, caus)
i = j - 1
rg = rg + 1
cn = 6
Exit For
ElseIf uno = due Then 'se uguali
If caus = Cells(j, 4).Value Then 'se le due causali sono uguali
datfin = Cells(j, 3).Value 'memorizza NUOVA data fine
i = j - 1
GoTo ripeti
ElseIf caus <> Cells(j, 4) Then 'se le due causali sono diverse
'scrive i dati memorizzati
x = Dati(rg, cn, uno, datini, datfin, caus)
i = j - 1
cn = cn + 3 'incrementa colonna
Exit For
End If
End If
ripeti:
Next j
Next i
Cells(ur, 1) = ClearContents
End Sub

Function Dati(ByVal rg As Long, ByVal cn As Long, _
ByVal uno As String, ByVal datini As Double, _
ByVal datfin As Double, ByVal caus As String)
Cells(rg, 6) = uno
Cells(rg, cn + 1) = datini
Cells(rg, cn + 2) = datfin
Cells(rg, cn + 3) = caus
End Function


Ecco il file [URL=qui]https://www.dropbox.com/s/ghmwr8ihzmcpvw8/Marius_VBA.xlsm?dl=0
Vedi se può andar bene.
Ciao,
Mario
Post: 874
Registered in: 7/4/2012
Senior User
2013
OFFLINE
10/16/2020 12:38 AM
 
Modify
 
Delete
 
Quote

Bel "quesito", mà ci arriv(e/rò) pure io (di norma, sempre per ultimo)
Visto stamani, e dovevo uscire. Dalle 21:00 alle 24:00 non trovo ancora una soluzione, mà ....non si mai quando?

Ho visto solo l'allegato di Marius44(ciao), non sono riuscito a scaricarlo.
Ho un quesito da fare, riguardo le riga14/17, dovrei visualizzare in XY... nome_8...25/03/2020...ed...19/04/2020. Mi sbaglio?
[Edited by ABCDEF@Excel 10/16/2020 4:47 AM]

Un saluto...
Non "quotate" l'intero messaggio, il post diventa illeggibile.
Post: 3,004
Registered in: 4/6/2013
Location: ROMA
Age: 73
Master User
2010
OFFLINE
10/16/2020 10:24 AM
 
Modify
 
Delete
 
Quote

@Mario

bello e sintetico.....

C'è solo una cosa da evidenziare:

Al nome_8 tu dai una prima continuità dal 25/3 al 19/4, ma non è corretta in quanto dovrebbe essere: 25/3 5/4 e poi 10/4 19/4 etc etc
Credo che da qualche parte manca un controllo di continuità delle date.

saluti





Domenico
Win 10 - Excel 2016
Post: 6,105
Registered in: 11/14/2004
Master User
Office 2019
ONLINE
10/16/2020 11:08 AM
 
Modify
 
Delete
 
Quote

Ciao Non riesco a scaricare il file di Mario che saluto.

@dodo, secondo me partiamo dall'ordinamento sbagliato, infatti mi sto orientando verso questo.

la chiave principale non sono i nominativi ma le causali secondo me.

vedo se riesco a ricavarne qualcosa

Ciao Salvatore
se ti piace la soluzione aiuta a sostenere il Forum con una DONAZIONE a piacere, Grazie






Iscriviti al nuovo sito che ho aperto troverai altre RISPOSTE
https://www.bysal-excel.it
Post: 3,005
Registered in: 4/6/2013
Location: ROMA
Age: 73
Master User
2010
OFFLINE
10/16/2020 11:20 AM
 
Modify
 
Delete
 
Quote

Re:
by sal, 16/10/2020 11:08:

Ciao Non riesco a scaricare il file di Mario che saluto.

@dodo, secondo me partiamo dall'ordinamento sbagliato, infatti mi sto orientando verso questo.

la chiave principale non sono i nominativi ma le causali secondo me.

vedo se riesco a ricavarne qualcosa

Ciao Salvatore




ma la discriminante non è solo la causale salvatore ma anche la continuità delle date e poi ciascun nome deve avere una sola riga

saluti




Domenico
Win 10 - Excel 2016
Post: 6,106
Registered in: 11/14/2004
Master User
Office 2019
ONLINE
10/16/2020 12:05 PM
 
Modify
 
Delete
 
Quote

Ciao Domenico, daccordo, ma non è un problema la sequenza delle date quello l'ho risolto, perche faccio un confronto con la data iniziale e la data finale del dato già trovato, se sono sequenziali allora la data finale diventa quella del secondo dato trovato e nello stesso tempo diventa la data di confronto se eventualmente ci sia un ulteriore confronto sequenziale.

alla fine scorrendo tutto per causale e nome ho un unico riferimento iniziale e finale.

logicamente se le date non sono sequenziali, sempre per causale e nome, allora si apre una nuova scritta di data inizio-fine e causale

finito una causale si passa alla successiva controllando se è già inserito il nome, se non inserito si aggiunge altrimenti si segue sulle colonne dello stesso nome con la nuova causale.

insomma questo è il principio, l'ordinamento va fatto per causale->nome->data iniziale.

ora sto cercando di realizzarlo, appena riesco a combinare le cose te lo passo

facendolo per nome da problemi la causale con il vba, almeno secondo me.

Ciao Salvatore
[Edited by by sal 10/16/2020 12:09 PM]
se ti piace la soluzione aiuta a sostenere il Forum con una DONAZIONE a piacere, Grazie






Iscriviti al nuovo sito che ho aperto troverai altre RISPOSTE
https://www.bysal-excel.it
Post: 3,006
Registered in: 4/6/2013
Location: ROMA
Age: 73
Master User
2010
OFFLINE
10/16/2020 12:17 PM
 
Modify
 
Delete
 
Quote

che dirti salvatore, in entrambe le opzioni di ordinamento devi sempre controllare o la contiguità o la causale.

Io, come detto, l'ho risolto (seppur farraginosamente) con quell'ordinamento proposto.

Naturalmente tutto è ribaltabile.

ciao




Domenico
Win 10 - Excel 2016
Post: 6,107
Registered in: 11/14/2004
Master User
Office 2019
ONLINE
10/16/2020 3:57 PM
 
Modify
 
Delete
 
Quote

Ciao Domenico ecco il file con la macro, per l'ordinamento ho usato il registratore.

vedi se va bene, ho usato anche un flag per le voci già selezionate un 1 nella colonna 5, per non conteggiarle di nuovo, che poi elimino alla fine della macro, anche se mi succede una cosa che non dovrebbe succedere mi rimangono degli 1 non so perche non ho usato nessun "screnupdating" che potesse succedere, ma poi la cosa bella che se cambio foglio e ritorno sul foglio scompaiono, Mah!! forse sarà il mio pc

ho inserito anche altre voci per fare un controllo, comunque fai tu i controlli e vedi se tutto va bene.

nel caso posso anche farti inserire le intestazioni se mancano.

Un Saluto Ciao Salvatore (8-D
[Edited by by sal 10/16/2020 3:58 PM]
se ti piace la soluzione aiuta a sostenere il Forum con una DONAZIONE a piacere, Grazie






Iscriviti al nuovo sito che ho aperto troverai altre RISPOSTE
https://www.bysal-excel.it
Post: 3,007
Registered in: 4/6/2013
Location: ROMA
Age: 73
Master User
2010
OFFLINE
10/16/2020 4:29 PM
 
Modify
 
Delete
 
Quote

Grazie Salvatore, va bene
Non ho notato la faccenda degli 1....(se non in debug).

Aggiungerò un sort finale per nominativo.

Ritengo chiuso il 3D

grazie a tutti.
saluti




Domenico
Win 10 - Excel 2016
Post: 6,108
Registered in: 11/14/2004
Master User
Office 2019
ONLINE
10/16/2020 4:50 PM
 
Modify
 
Delete
 
Quote

Ciao allora sarà il mio PC, e da tempo che non faccio un poco di pulizia e aggiornamento.

l'importante che funziona.

Ciao Salvatore (8-D

se ti piace la soluzione aiuta a sostenere il Forum con una DONAZIONE a piacere, Grazie






Iscriviti al nuovo sito che ho aperto troverai altre RISPOSTE
https://www.bysal-excel.it
Post: 841
Registered in: 6/24/2015
Location: CATANIA
Age: 76
Senior User
Excel2010
OFFLINE
10/16/2020 7:04 PM
 
Modify
 
Delete
 
Quote

Salve a tutti
Sono stato impegnato e non mi son potuto dedicare ancora al problema. Maglio così, visto che Salvato (che saluto cordialmente) ha trovato la soluzione.

Per Domenico:
Non era SOLO il nome_8 ma anche il nome_2

Comunque tutto è bene quel che finisce bene!!!!!

Ciao a tutti,
Mario
Post: 876
Registered in: 7/4/2012
Senior User
2013
OFFLINE
10/17/2020 6:47 AM
 
Modify
 
Delete
 
Quote

Ciao a tutti
Sara una mia impressione, sul files allegato non ci dovrebbe essere
09/04/2020 17/04/2020 BB mà 30/03/2020 17/04/2020 BB
Sub Unisci()
Dim Ur, x, rg, rc, w
Ur = Range("A" & Rows.Count).End(xlUp).Row
Range("F2:AA" & Ur).Clear
rg = 2
    For x = 2 To Ur
        If Cells(x, 1) <> Cells(x - 1, 1) Then
            w = 6
            Range("A" & x & ":D" & x).Copy Destination:=Cells(rg, w)
            If Cells(x, 1) <> Cells(x - 1, 1) Or Cells(x, 4) <> Cells(x - 1, 4) Then rg = rg + 1
            GoTo fine
        End If
        If Cells(x, 1) = Cells(x - 1, 1) Then
            If Cells(x, 3) > Cells(x - 1, 3) And Cells(x, 4) = Cells(x - 1, 4) Then
                rc = Range("F" & Rows.Count).End(xlUp).Row
                w = Cells(rc, 16000).End(xlToLeft).Column + 1
                Cells(x, 3).Copy Destination:=Cells(rc, w - 2)
            ElseIf Cells(x, 4) <> Cells(x - 1, 4) Then
                rc = Range("F" & Rows.Count).End(xlUp).Row
                w = Cells(rc, 16000).End(xlToLeft).Column + 1
                Range("B" & x & ":D" & x).Copy Destination:=Cells(rc, w)
            End If
        End If
fine:
    Next
MsgBox "fatto"
End Sub

Un saluto...
Non "quotate" l'intero messaggio, il post diventa illeggibile.
Admin Thread: | Close | Move | Delete | Modify | Email Notification Previous page | 1 | Next page
New Thread
 | 
Reply
Cerca nel forum
Tag discussione
Discussioni Simili   [vedi tutte]
Home Forum | Bacheca | Album | Users | Search | Log In | Register | Admin
Tutti gli orari sono GMT+01:00. Adesso sono le 6:12 PM. : Printable | Mobile | Regolamento | Privacy
FreeForumZone [v.5.2] - Copyright © 2000-2020 FFZ srl - www.freeforumzone.com