Autres Aide macro ou formules

[daewoo41]

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

 

[daewoo41]

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

 

[job75]

Bonjour daewoo41, le forum,

Ci-joint le 1er fichier avec cette macro dans la feuille "Synthèse" :

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.

 

[job75]

Ci-joint le 2ème fichier avec cette macro dans la feuille "Synthèse" :

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

 

[daewoo41]

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