Autres Aide macro ou formules

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
 

Fichiers joints

Dernière édition:

daewoo41

XLDnaute Nouveau
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

XLDnaute Barbatruc
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.
 

Fichiers joints

job75

XLDnaute Barbatruc
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
 

Fichiers joints

daewoo41

XLDnaute Nouveau
Un grand merci job75, tout fonctionne à merveille... Mais je n'arrive toujours pas à comprendre les 2 macros... o_O 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
 

Discussions similaires


Haut Bas