Elaborazione tabella

[nima]

Buonasera,
avrei necessità di una mano per risolvere un problemino.... non sono uno esperto ma cerco di arrangiarmi per quello che devo fare a lavoro con excel.
Avrei bisogno di una macro, che vorrei attivare con un pulsante, per poter elaborare una tabella.
Nella tabella formate da 5 colonne e "n" righe sono segnati degli orari e delle date che a volte si ripetono come per esempio:

_____ A _______ B ___ C ___ E ____ F
09/06/2015__ 06:55__ 0__ 21:04__ 0

08/06/2015__ 16:53__ 0__ 21:00__ 0
08/06/2015__ 07:51__ 0__ 15:30__ 0

04/06/2015__ 06:53__ 0__ 23:01__ 0

Vorrei in sostanza che la righe contengano date univoche e che i valori della riga da cancellare vengano riportate sulla riga che rimane; rifacendomi all'esempio vorrei che il risultato dell'elaborazione sia:

_____ A _______ B _____ C ____ E _____ F

09/06/2015__ 06:55____ 0____ 21:04____ 0

08/06/2015__ 07:51__ 15:30 __ 16:53__ 21:00

04/06/2015__ 06:53____ 0____ 23:01____ 0

Nella realtà molte altre date con altri orari sono ripetuti, questo è solo un esempio.
Spero di essere stato chiaro nella spiegazione e ricostruzione di tabella!!!..... grazie

[Anthony47]

Ciao nima, benvenuto nel forum.
Per ragionare bene ti chiederei di pubblicare un file contenente un campionario abbastanza esauriente di situazioni.
Per come fare guarda qui: viewtopic.php?f=26&t=103893&p=605487#p605487

[nima]

Ciao e grazie per il suggerimento.
Allego qui un link dove possibile scaricare un file .xlsx dove troverai due fogli:
Nel primo foglio troverai i dati come vi verranno consegnati.
Nel secondo foglio in pratica è il risultato che vorrei ottenere dopo l'elaborazione cliccando su un ipotetico tasto.
In sostanza la differenza sarà nella riga dell' 8 giugno.

http://we.tl/heAOpsIUhi

Spero di essermi spiegato.
A presto....

[Anthony47]

Penso che questa macro dovrebbe funzionare:

Codice: Seleziona tutto

Sub TSTransl()
Dim Orig As String, Dest As String, I As Long, myMatch, myNext As Long
'
Orig = "Foglio1"        '<<<< Il foglio di partenza
Dest = "Foglio 2"       '<<<< Il foglio di destinazione
'
Sheets(Orig).Select
For I = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    If Cells(I, 1).Value <> "" And Application.WorksheetFunction.CountIf(Range("A1").Resize(I, 1), CLng(Cells(I, 1).Value)) < 2 Then
        myNext = Sheets(Dest).Cells(Rows.Count, 1).End(xlUp).Row + 1
        myMatch = Application.Match(CLng(Cells(I, 1).Value), Cells(I + 1, 1).Resize(100, 1), 0)
        If IsError(myMatch) Then
            Cells(I, 1).Resize(1, 7).Copy Sheets(Dest).Cells(myNext, 1)
        Else
            Cells(I + myMatch, 1).Resize(1, 3).Copy Sheets(Dest).Cells(myNext, 1)
            Cells(I + myMatch, 6).Copy Sheets(Dest).Cells(myNext, 4)
            Cells(I, 3).Copy Sheets(Dest).Cells(myNext, 6)
            Cells(I, 6).Copy Sheets(Dest).Cells(myNext, 7)
        End If
    End If
Next I
MsgBox ("Completato...")
End Sub

Mettila in un modulo standard, personalizzando le righe marcate <<<; eventualmente assegnala a un pulsante. Poi quando vuoi ottenere la tabella traslata mandala in esecuzione.
La tabella sara' inserita nel foglio di Destinazione, accodandola ai dati eventualmente gia' presenti.
Dovrai poi salvare il file nel formato "macro enabled", cioe' .xlsm

Ciao

[nima]

Grazie Anthony47,
ho copiato la macro, aggiunto pulsante e funziona tutto correttamente.......
Mi hanno passato i file dei dati ma ho avuto una piccola sorpresa.... i dati sono messi in posizioni differenti.... ho provato a fare le modifiche ma..... non sono all'altezza .
Ti invio un link dove puoi scaricare il nuovo file..... come potrai notare avrai i due fogli con la situazione attuale e il foglio con l'elaborazione effettuata. Rispetto a prima non ci sono molti cambiamenti ma ti volevo evidenziare:
1- la prima riga come puoi notare ha un allineamento diverso
2- è stata aggiunta un'ultima colonna che vorrei riportare nel nuovo foglio
3- ti ricordo che dove viene riportata la stessa data, nell'ultima colonna verrà riportata la somma delle ore delle due righe

Scusa per il disturbo..... e grazie 1000

http://we.tl/yZooVXNP3H

[Anthony47]

Rispetto a prima non ci sono molti cambiamenti

Veramente tra il primo tracciato e questo secondo l'unica cosa in comune e' che ambedue contengono date e orari messi a caso; e parlando del "messi a caso" faccio osservare che anche la prima linea avente un layout a se stante e' esilarante, spero che chi ha prodotto il file non lavori nel settore dell'informatica.
Secondo me la prima cosa da chiarire con chi ti consegna i file e' che deve farlo sempre nello stesso formato, ne scelga uno e usi sempre quello.
Quando questo sara' chiaro allora avra' senso sviluppare una macro che "aggiusta" le colonne come servono; a oggi saremmo in balia della sorte.

Sorry...

[nima]

Ho parlato chiaramente con chi mi passerà i dati e mi ha confermato il secondo formato che nasce da un copia/Incolla.No so il perché la prima riga è diversa dalle altre. Ho provato a modificare la macro ma non sono all'altezza.
Cortesemente mi puoi aiutare. Grazie

[Anthony47]

Prendendo per oro colato quanto ti hanno detto:

Codice: Seleziona tutto

Sub TSTranStrano()
Dim Orig As String, Dest As String, I As Long, myMatch, myNext As Long
'
Orig = "Foglio1"        '<<<< Il foglio di partenza
Dest = "Foglio 2"       '<<<< Il foglio di destinazione
'
Sheets(Orig).Select
For I = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    If I = 1 Then myoff = 0 Else myoff = 2
    If Cells(I, 1).Offset(0, myoff).Value <> "" And Application.WorksheetFunction.CountIf(Range("A1").Offset(0, 2).Resize(I, 1), CLng(Cells(I, 1).Offset(0, myoff).Value)) < 2 Then
        myNext = Sheets(Dest).Cells(Rows.Count, 1).End(xlUp).Row + 1
        myMatch = Application.Match(CLng(Cells(I, 1).Offset(0, myoff).Value), Cells(I + 1, 1).Offset(0, myoff).Resize(100, 1), 0)
        If IsError(myMatch) Then
            Cells(I, 1).Offset(0, myoff).Resize(1, 9).Copy Sheets(Dest).Cells(myNext, 1)
        Else
            Cells(I + myMatch, 1).Offset(0, myoff).Resize(1, 3).Copy Sheets(Dest).Cells(myNext, 1)
            Cells(I + myMatch, 6).Offset(0, myoff).Copy Sheets(Dest).Cells(myNext, 4)
            Cells(I, 3).Offset(0, myoff).Copy Sheets(Dest).Cells(myNext, 6)
            Cells(I, 6).Offset(0, myoff).Copy Sheets(Dest).Cells(myNext, 7)
            Sheets(Dest).Cells(myNext, 9) = Cells(I + myMatch, 9 + myoff).Value + Cells(I, 9 + myoff).Value
        End If
    End If
Next I
MsgBox ("Completato...")
End Sub

Vediamo quanto dura...