Autres Aide macro ou formules

  • Initiateur de la discussion Initiateur de la discussion daewoo41
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

daewoo41

XLDnaute Nouveau
Bonsoir,

Je poste une nouvelle discussion, je ne sais pas si je fais bien... .
Je fais un copier/coller d'un document html (enfin je crois) vers mon fichier excel (en exemple ce que ça donne).
Je souhaiterais dans mon fichier excel (dans un onglet synthèse par exemple) savoir quelle(s) personne(s) a un bagdeage avant 8:00 et/ou après 19:00 en me donnant la date et l'heure de pointage.

Avez-vous des idées pour automatiser tout ça (car je n'ai pas les données sur toutes les lignes je ne vois pas comment faire sauf à reporter manuellement la date et le nom sur toutes les lignes) ? J'ai reçu une première macro, mais je n'arrive pas à l'adapter pour les 2 fichiers, si vous avez des idées je suis preneur.

Merci par avance.

Bonne journée
 

Pièces jointes

Dernière édition:
j'ai complétement oublié d'inscrire la macro de job75 que je n'arrive pas à adapter :

Private Sub Worksheet_Activate()
Dim tablo, resu, i&, n&
With Feuil1.UsedRange 'CodeName de la feuille
tablo = .Resize(, 3) 'matrice, plus rapide
ReDim resu(1 To 2 * Application.Count(.Columns(1)), 1 To 4)
End With
For i = 1 To UBound(tablo)
If IsDate(tablo(i, 1)) Then
If tablo(i + 1, 3) < TimeValue("08:00") Then
n = n + 1
resu(n, 1) = tablo(i - 1, 2)
resu(n, 2) = tablo(i, 1)
resu(n, 3) = tablo(i + 1, 2)
resu(n, 4) = tablo(i + 1, 3)
End If
If tablo(i + 4, 3) > TimeValue("19:00") Then
n = n + 1
resu(n, 1) = tablo(i - 1, 2)
resu(n, 2) = tablo(i, 1)
resu(n, 3) = tablo(i + 4, 2)
resu(n, 4) = tablo(i + 4, 3)
End If
End If
Next
With [A3] 'à adapter
If n Then
.Resize(n, 4) = resu
.Resize(n, 4).Sort .Cells(1), xlAscending, .Cells(1, 2), , xlAscending, Header:=xlNo 'tri
.Resize(n, 4).Borders.Weight = xlThin 'bordures
End If
.Offset(n).Resize(Rows.Count - n - .Row + 1, 4).Delete xlUp 'RAZ en dessous
End With
End Sub



Bonne journée
 
Bonjour daewoo41, le forum,

Ci-joint le 1er fichier avec cette macro dans la feuille "Synthèse" :
VB:
Private Sub Worksheet_Activate()
Dim tablo, resu(), i&, mat$, txt$, n&, p%
With Feuil1.UsedRange 'CodeName de la feuille
    tablo = .Resize(, 3) 'matrice, plus rapide
    ReDim resu(1 To 2 * Application.Count(.Columns(1)), 1 To 3)
End With
For i = 1 To UBound(tablo)
    If tablo(i, 1) Like "Matricule*" Then mat = tablo(i, 1)
    If IsDate(tablo(i, 1)) Then txt = mat & Chr(1) & tablo(i, 1)
    If IsNumeric(CStr(tablo(i, 3))) And mat <> "" Then
        If tablo(i, 3) < TimeValue("08:00") Or tablo(i, 3) > TimeValue("19:00") Then
            n = n + 1
            p = InStr(txt, Chr(1))
            resu(n, 1) = Left(txt, p - 1)
            resu(n, 2) = CDate(Mid(txt, p + 1))
            resu(n, 3) = tablo(i, 3)
        End If
    End If
Next
With [A3] 'à adapter
    If n Then
        .Resize(n, 3) = resu
        .Resize(n, 3).Sort .Cells(1), xlAscending, .Cells(1, 2), , xlAscending, Header:=xlNo 'tri
        .Resize(n, 3).Borders.Weight = xlThin 'bordures
    End If
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 3).Delete xlUp 'RAZ en dessous
End With
End Sub
Bonne journée.
 

Pièces jointes

Ci-joint le 2ème fichier avec cette macro dans la feuille "Synthèse" :
VB:
Private Sub Worksheet_Activate()
Dim tablo, resu(), i&, dat As Date, h#, n&
tablo = Feuil1.[A1].CurrentRegion.Resize(, 4) 'matrice, plus rapide
ReDim resu(1 To UBound(tablo), 1 To 3)
For i = 1 To UBound(tablo)
    If IsDate(tablo(i, 2)) Then dat = tablo(i, 2)
    If tablo(i, 4) Like "##:##" Then tablo(i, 4) = CDbl(CDate(tablo(i, 4)))
    If IsNumeric(CStr(tablo(i, 4))) Then
        h = CDbl(CStr(tablo(i, 4)))
        If h < TimeValue("08:00") Or h > TimeValue("19:00") Then
            n = n + 1
            resu(n, 1) = tablo(i, 1)
            resu(n, 2) = dat
            resu(n, 3) = h
        End If
    End If
Next
With [A3] 'à adapter
    If n Then
        .Resize(n, 3) = resu
        .Resize(n, 3).Sort .Cells(1), xlAscending, .Cells(1, 2), , xlAscending, Header:=xlNo 'tri
        .Resize(n, 3).Borders.Weight = xlThin 'bordures
    End If
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 3).Delete xlUp 'RAZ en dessous
End With
End Sub
 

Pièces jointes

Un grand merci job75, tout fonctionne à merveille... Mais je n'arrive toujours pas à comprendre les 2 macros... 😵 surement trop compliqué pour moi, pourtant vous avez indiqué quelques informations dans votre macro (mais je ne comprends toujours pas comment paramétrer "tablo", le "i", "resu"...), il me faudrait une bonne formation macro...
Merci et bonne soirée
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
3
Affichages
534
Réponses
3
Affichages
490
Réponses
7
Affichages
971
Réponses
6
Affichages
665
Retour