Résume de données de tableau(récapitulatif)

[Felicite1976]

Bonjour tout le monde
j'ai un tableau (voir fichier joint) où je veux effectuer par inspecteur la somme des éléments de la colonne H dans la colonne Q et la somme des éléments de la colonne I dans la colonne R,mon probleme est comment prendre en compte la mise à jour du premier tableau
Je m'explique Par exemple pour Abdel Ben Mansour si on ajoute de nouvelle valeur(y'a 10 éléments apres mise à jour on peut avoir plus de 10 lignes ) comment avoir cela dans mon tableau resultat
Aussi on peut avoir après mise à jour de nouveau inspecteur à l'interieur ou à la fin du tableau ,là aussi je voudrais savoir comment avoir ces infos dans mon tableau resultat.
MErci de votre aide

 

[natorp]

Bjr Felicite

Une idée en pièce-jointe...

Cordialement, Gérard

 

[Dugenou]

Bonjour,
le plus simple est de refaire votre tableau :

1. en répétant le nom sur chaque ligne
2. en évitant les cellules fusionnées (vous pouvez élargir les colonnes)
3. en le délcarant comme un "tableau"

Vous aurez alors une base données dans laquelle vous pouvez ajouter des lignes comme bon vous semble et retrier si besoin.
Ensuite un tableau croisé dynamique ou des sous totaux vous permettront d'afficher ce dont vous avez besoin.

Voir pj

 

[Felicite1976]

Bonjour
Merci Dugenou et Natorp mais comme je lai dit mon fichier est mise à jour régulièrement .
Je demande comment au chargement je peux répéter le nom de chaque inspecteur sur les lignes vides car j'ai pas de controle sur le fichier j'ai juste mis un lien pour le charger dans mon application
Merci

 

[chris]

Bonjour à tous

Par curiosité, il vient d'où ce tableau ?

On dirait un export rebidouillé...

Avec ce type de structure où le nom apparait une fois en fin de bloc, avec des cellules fusionnées sans aucun raison...

Il faudra au minimum une colonne ajoutée après import pour pouvoir faire tes stats...

 

[klin89]

Bonsoir le fil,

A tester :

Option Explicit
Sub test()
Dim a(), myAreas As Areas, i As Long, n As Long
    Application.ScreenUpdating = False
    On Error Resume Next
    Set myAreas = Sheets(1).Columns(5).SpecialCells(2, 2).Areas
    On Error GoTo 0
    If myAreas Is Nothing Then Exit Sub
    ReDim a(1 To myAreas.Count - 1, 1 To 4)
    For i = 2 To myAreas.Count
        n = n + 1
        a(n, 1) = myAreas(i).Offset(myAreas(i).Rows.Count, -4).Resize(1, 1).Value
        a(n, 2) = Application.Sum(myAreas(i).Offset(, 2))
        a(n, 3) = Application.Sum(myAreas(i).Offset(, 4))
        If a(n, 2) > 0 Then a(n, 4) = a(n, 3) / a(n, 2)
    Next
    With Sheets(1).Range("p3").Resize(, 4)
        .CurrentRegion.Clear
        .Value = [{"Nom inspecteur","Interventions totales","Totale intervention vérifiées","Pourcentage"}]
        .Offset(1).Resize(n).Value = a
        With .CurrentRegion
            .Font.Name = "calibri"
            .Font.Size = 10
            .VerticalAlignment = xlCenter
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            With .Rows(1)
                .BorderAround Weight:=xlThin
                .HorizontalAlignment = xlCenter
                .Interior.ColorIndex = 36
                .Font.Size = 11
            End With
            .Columns(4).NumberFormat = "0.00%"
            .Columns.AutoFit
        End With
    End With
    Application.ScreenUpdating = True
End Sub

C'est pas top tes cellules fusionnées
klin89

 

[klin89]

Re Felicite1976,

Au préalable, on peut procéder à un petit nettoyage de la Feuil1

Option Explicit
Sub nettoyage()
'nettoyage préalable de la Feuil1
Dim derCol As Long, i As Long
    Application.ScreenUpdating = False
    With Sheets("Feuil1")
        .UsedRange.UnMerge
        derCol = Cells(3, Columns.Count).End(xlToLeft).Column
        For i = derCol To 1 Step -1
            If Application.WorksheetFunction.CountA(.Columns(i)) = 0 Then
                .Columns(i).Delete
            End If
        Next
    End With
    Application.ScreenUpdating = True
End Sub

Puis exécuter la 2ème macro pour obtenir le résultat souhaité :

Sub test()
Dim a(), myAreas As Areas, i As Long, n As Long
    Application.ScreenUpdating = False
    On Error Resume Next
    Set myAreas = Sheets("Feuil1").Columns(2).SpecialCells(2, 2).Areas
    On Error GoTo 0
    If myAreas Is Nothing Then Exit Sub
    ReDim a(1 To myAreas.Count, 1 To 4)
    n = 1
    a(n, 1) = "Nom inspecteur": a(n, 2) = "Interventions totales"
    a(n, 3) = "Totale intervention vérifiées": a(n, 4) = "Pourcentage"
    For i = 2 To myAreas.Count
        n = n + 1
        a(n, 1) = myAreas(i).Offset(myAreas(i).Rows.Count, -1).Resize(1).Value
        a(n, 2) = Application.Sum(myAreas(i).Offset(, 2))
        a(n, 3) = Application.Sum(myAreas(i).Offset(, 3))
        If a(n, 2) > 0 Then a(n, 4) = a(n, 3) / a(n, 2)
    Next
    With Sheets("Feuil1").Cells(3, 1).End(xlToRight).Offset(, 3)
        .CurrentRegion.Clear
        With .Resize(n, 4)
            .Value = a
            .Font.Name = "calibri"
            .Font.Size = 10
            .VerticalAlignment = xlCenter
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            With .Rows(1)
                .BorderAround Weight:=xlThin
                .HorizontalAlignment = xlCenter
                .Interior.ColorIndex = 22
            End With
            .Columns(4).NumberFormat = "0.00%"
            .Columns.AutoFit
        End With
    End With
    Application.ScreenUpdating = True
End Sub

klin89

 

[Felicite1976]

Merci Klin 89
je l'ai testé mais pas de resultat