Macro Excel

Bonjour,

Dans mon fichier j'ai des jours et des heures. Je souhaiterai créer une macro pour m'aider. Voici mon cas :

Lundi 21:00

Lundi 21:00

Lundi 21:00

Etc... même principe quelque soit le jour et l'heure

Il faudrait que quand il y a ce cas de figure et quelque soit le jour que Excel fasse cela automatiquement. C'est à dire que si il y a deux ou plusieurs créneaux horaires identique que 1 minute soit ajouté. Donc :

Lundi 21:00

Lundi 21:01

Lundi 21:02

Merci d'avance

Cdt

Bonsoir,

"La 25ème heure"

c'est le titre d'un film çà !

Claude

lol vous avez une idée svp ?

re,

essaye avec

Sub HeureX()
Dim Lg%, i%, J%, x As Date
'Macro par Claude Dubois pour "dexter59" Excel-Pratique le 08/10/10
    Lg = Range("e65536").End(xlUp).Row
    x = Format(1 / 24 / 60, "hh:mm:ss")
    For i = 3 To Lg
        If Cells(i, "e") = Cells(i - 1, "e") Then
                J = i
            Do While Cells(J, "e") = Cells(i - 1, "e")
                Cells(J, "e") = Cells(J - 1, "e") + x
                J = J + 1
            Loop
        End If
    Next i
End Sub

Amicalement

Claude

Merci beaucoup. J'ai besoin d'un dernier coup de main car j'ai modifié mon fichier et la macro ne marche pas avec celui que je viens de joindre. Pouvez vous me donner la nouvelle macro pour le fichier en pièce jointe svp.

De plus savez vous comment faire pour ne pas qu'il y ai le bouton Go et pour que je puisse activer la macro manuellement ?

Sub HeureX()
Dim Lg%, i%, J%, x As Date
'Macro par Claude Dubois pour "dexter59" Excel-Pratique le 08/10/10
    Lg = Range("f65536").End(xlUp).Row
    x = Format(1 / 24 / 60, "hh:mm:ss")
    For i = 19 To Lg
        If Cells(i, "f") = Cells(i - 1, "f") Then
                J = i
            Do While Cells(J, "f") = Cells(i - 1, "f")
                Cells(J, "f") = Cells(J - 1, "f") + x
                J = J + 1
            Loop
        End If
    Next i
End Sub

tu peux supprimer le bouton

Merci c'est parfait ca marche !! J'ai 2 dernières questions :

Est-ce que la macro la prendra en charge toutes les nouvelles heures que j'ajouterai dans mon tableau ? Par exemple jusque la ligne 5500

Pourquoi quand je mets la touche e en raccourci clavier sous Excel 2007 pour l'exécuter avec CTRL+e ca ne fonctionne pas. J'ai un message d'erreur Microsoft Visual Basic. Pour l'activer je dois donc faire exécuter mais la touche raccourci marche pas.

Merci vous êtes génial

re,

vois dans les options macro

Ctrl+e

Merci ca semble marcher. C'est ce que j'avais fais mais bizzare

Merci c'est top !

-- Ven Oct 08, 2010 10:28 pm --

Au fait je pense à quelque chose. Je pense qu'il manque juste quelque chose car mes résultats sont erronés. En effet si jamais j'ai 23:00:00 le mercredi et le jeudi 23:00:00 celui du jeudi va passer en 23:00:01 et il ne faut pas. Il faut que l'ajout d'une minute à chaque fois se fasse que si les heures sont identiques mais le même jour. Pouvez vous me recommuniquer la macro adéquate svp.

Merci encore et désolé.

si tu as 5000 lignes, ajoute cette ligne en début de macro

Application.ScreenUpdating = False
Lg = Range("f65536").End(xlUp).Row

et n'oublie pas de solder le poste

Bonjour,

Merci pour cette réponse mais il manque cela au fait :

En effet si jamais j'ai 23:00:00 le mercredi et le jeudi 23:00:00 celui du jeudi va passer en 23:00:01 et il ne faut pas. Il faut que l'ajout d'une minute à chaque fois se fasse que si les heures sont identiques mais le même jour. Pouvez vous me recommuniquer la macro adéquate svp.

En gros pour conclure j'aurais besoin de la macro avec ceci :

- Que ma macro s'applique à l'infini pour toute la colonne F et

- Que si jamais j'ai 23:00 le mercredi et 23:00 le jeudi (donc pas le même jour) que cela n'ajoute pas 1 minute.

Merci d'avance

Bonjour,

Sub HeureX()
Dim Lg%, i%, J%, x As Date, Plg$, Plg2$
'Macro par Claude Dubois pour "dexter59" Excel-Pratique le 09/10/10
    Application.ScreenUpdating = False
    Lg = Range("f65536").End(xlUp).Row
    x = Format(1 / 24 / 60, "hh:mm:ss")
    For i = 19 To Lg
        Plg = Cells(i, "d") & Cells(i, "f")
        Plg2 = Cells(i - 1, "d") & Cells(i - 1, "f")
        If Plg = Plg2 Then
                J = i
            Do While Cells(J, "d") & Cells(J, "f") = Plg2
                Cells(J, "f") = Cells(J - 1, "f") + x
                J = J + 1
            Loop
        End If
    Next i
End Sub

Amicalement

Claude