Transformation nombre de colonnes d'un tableau horodaté

Bonjour à tous les experts,

J'ai une petite difficulté pour transformer un tableau (ci-joint).

Ce que j'ai : 3 colonnes : Date / Heure (toutes les 10 minutes) / Donnée

EXEMPLE :

01/01/2014 0:00 451

01/01/2014 0:10 454

01/01/2014 0:20 460

01/01/2014 0:30 438

01/01/2014 0:40 441

01/01/2014 0:50 435

01/01/2014 1:00 435

01/01/2014 1:10 415

01/01/2014 1:20 420

01/01/2014 1:30 413

01/01/2014 1:40 382

01/01/2014 1:50 381

Ce que je veux, c'est regrouper les données par heure, c'est à dire :

Date / Heure pile / Données de l'heure,

EXEMPLE :

01/01/2014 0:00 451 454 460 438 441 435

01/01/2014 1:00 435 415 420 413 382 381

ETC.... comme c'est sur une année, j'ai donc à la base 52560 lignes....

Des idées avec des boucles et des recopiages ?

Merci !!

Bon,

J'ai trouvé une solution, pas optimisée vu le temps que ca mets !

Mais une solution quand même...

Sub Transform()

Range("A1").Select

' Faire tant que la cellule active n'est pas vide
    tab_initial = 1
    tab_final = 1

Do While Not (IsEmpty(Cells(tab_initial, 1)))

    Range(Cells(tab_initial, 1), Cells(tab_initial, 2)).Select
    Selection.Copy
    Cells(tab_final, 6).Select
    ActiveSheet.Paste
    Range(Cells(tab_initial, 3), Cells(tab_initial + 5, 3)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Cells(tab_final, 8).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True

    tab_initial = tab_initial + 6
    tab_final = tab_final + 1
Loop
End Sub

Si vous avez des idées pour l'optimiser ?

Bonjour,

Une solution formules pour commencer...

Je suis d'accord que pour plus de 50000 lignes ce ne sera pas optimal !

Mais pas forcément inutile. Les formules en E, F, G se recopient vers le bas, la formule en H se recopie vers la droite et le bas. La colonne E peut être masquée.

J'ai transféré les données dans un autre classeur pour retrouver une célérité normale de calcul (mais il est sûr que chargé ça ramera).

Pas le temps de regarder macro (à mon retour si la question n'est pas déjà réglée).

Bonne journée.

Ferrand

Et une macro vite fait :

Sub RecompTab()
    Dim i&, j&, n&, k%
    With ThisWorkbook.Names
        .Add "tab_init", Range("A2")
        .Add "tab_fin", Range("F2")
    End With
    n = Range("A" & Rows.Count).End(xlUp).Row
    With [tab_init]
        For i = 1 To n Step 6
            j = Int(i / 6) + 1
            For k = 1 To 3
                [tab_fin].Cells(j, k).Value = .Cells(i, k).Value
            Next k
            For k = 1 To 5
                [tab_fin].Cells(j, k + 3).Value = .Cells(i + k, 3).Value
            Next k
        Next i
    End With
End Sub

Elle sera à compléter par des tests de vérification au démarrage (cas où la première ligne du tableau n'est pas sur une heure entière) et mise au format des colonnes date et heure du tableau final (si on ne le fait pas préalablement)... mais tu peux déjà tester

La macro a été insérée sur ton fichier communiqué (et la vitesse d'exécution paraît satisfaisante).

Bonne continuation.

Ferrand

Un grand Merci MFerrand !

Ca marche bien et vite !!

J'ai remplacé dans ton code A2 et F2 par A1 et F1 car mon tableau initial commencait en A1 mais au TOP !

Merci, et bonne journée !!

Bonsoir ydol, MFerrand, le forum

Avec un dictionnaire.

Tes données en colonnes A, B et C à partir de la ligne 1.

Option Explicit
Sub test()
Dim a, i As Long, n As Long, maxCol As Long, w, txt As String
    With Range("a1").CurrentRegion
        a = .Value: maxCol = UBound(a, 2)
        ReDim Preserve a(1 To UBound(a, 1), 1 To UBound(a, 2) + 10)
        With CreateObject("Scripting.Dictionary")
            For i = 1 To UBound(a, 1)
                txt = Join$(Array(a(i, 1), Int(a(i, 2) * 24)))
                If Not .exists(txt) Then
                    n = n + 1: .Item(txt) = VBA.Array(n, 3)
                    a(n, 1) = a(i, 1)
                    'a(n, 2) = Application.WorksheetFunction.RoundDown(a(i, 2) * 24, 0) / 24
                    a(n, 2) = Int(a(i, 2) * 24) / 24
                    a(n, 3) = a(i, 3)
                Else
                    w = .Item(txt): w(1) = w(1) + 1
                    .Item(txt) = w
                    If UBound(a, 2) < w(1) Then
                        ReDim Preserve a(1 To UBound(a, 1), _
                                         1 To UBound(a, 2) + 10)
                    End If
                    a(w(0), w(1)) = a(i, 3)
                    maxCol = Application.Max(maxCol, w(1))
                End If
            Next
        End With
        With .Offset(, .Columns.Count + 2).Resize(n, maxCol)
            .CurrentRegion.ClearContents
            .Value = a
            .Columns(2).NumberFormat = "h:mm;@"
            .Columns.AutoFit
        End With
    End With
End Sub

klin89