Remplir des données manquantes

Bonjour a tous,

Je reviens vers vous pour une petite manip qui je pense n'est pas bien méchante mais bon, moi et Excel...

Je dispose d'une plage de données organisée de la maniere suivante:

Une colonne avec des valeurs, chacune correspondant a une date/heure. Les mesures sont espacées d'une heure.

Le hic c'est que j'ai des trous au niveau du temps. Je voudrais donc rajouter les mesures aux temps qu'il me manque.

Exemple:

2 14:00

3 15:00

4 17:00

devient:

2 14:00

3 15:00

cellule vide 16:00

4 17:00

Le fichier joint devrait expliquer plus clairement ma requete.

Merci !

42explications.xlsx (11.33 Ko)

Bonjour,

A tester :

Sub CompléterHeures()
    Dim n%, i%
    With ActiveSheet
        n = .Cells(.Rows.Count, 2).End(xlUp).Row
        For i = n To 3 Step -1
            If Round(.Cells(i, 2), 2) <> Round(.Cells(i - 1, 2) + 1 / 24, 2) Then
                .Range("A" & i).Resize(, 2).Insert xlShiftDown
                .Cells(i, 2) = .Cells(i + 1, 2) - 1 / 24
                i = i + 1
            End If
        Next i
    End With
End Sub

Cordialement.

Bonjour,

Merci de la reponse, c'est exactement ce qu'il me fallait !

Elle fonctionne tres bien sur le fichier avec les quelques valeurs que j'avais mises comme exemple, mais quand j'essaie de l'appliquer a un grand nombre de valeurs, la macro tourne quelques secondes puis affiche l'erreur suivante :

"Methode 'Insert' of object 'Range' failed"

Un probleme de dimensions ?

Effectivement un problème survient quelque part, il m'a semblé que c'était entre 4000 et 5000 (?)

J'ai refait une macro sur une autre méthode mais elle bloque aussi, je vais revoir autrement, avec une autre méthode encore.

Peut etre que l'erreur vient de mes données ! Je n'en ai pas vu en regardant rapidement mais j'ai pu passer a coté...

Merci de passer du temps dessus en tout cas.

Cordialement.

Essaie cette nouvelle...

Sub TabHeures()
    Dim H(), n%, i%, j%, hh%
    With ActiveSheet
        n = .Range("B" & .Rows.Count).End(xlUp).Row
        hh = (.Cells(n, 2) - .Cells(2, 2)) / (1 / 24)
        ReDim H(hh, 1)
        For i = 0 To hh
            H(i, 1) = .Cells(2, 2) + i / 24
        Next i
        j = -2
        For i = 2 To n
            If Format(.Cells(i, 2), "dd/mm/yyyy hh:mm") = Format(H(i + j, 1), _
             "dd/mm/yyyy hh:mm") Then
                H(i + j, 0) = .Cells(i, 1)
            Else
                j = j + 1
            End If
        Next i
        .Range("F2:G2").Resize(hh + 1).Value = H
        .Range("G2").Resize(hh + 1).NumberFormat = "dd/mm/yyyy hh:mm"
        .Range("A1:B1").Copy .Range("F1")
    End With
End Sub

J'ai dû tout de même basculer les comparaisons, ici sur des valeurs String (au lieu des arrondis sur les versions précédentes) mais c'est équivalent, je ne sais toujours pas ce qui coinçait ! Mais celle-ci va au bout (et plus rapidement, efficacité des Array !!!! un salut à Galopin sur cette méthode...)

Cordialement.

Waouh, impressionnant. Merci beaucoup !!

Résolu !

Rechercher des sujets similaires à "remplir donnees manquantes"