Décompte de valeurs dans des onglets

[damien2103]

Bonjour à tous,

Tout est dans le fichier joint, aussi bien la demande que mon essai (qui ne fonctionne en fait pas car avec trop de valeurs/champs, Excel rame comme c'est pas permis !)

je suis sous Excel 2010

En fait j'ai un nouvel onglet de données chaque jour. A partir des 5 derniers onglets, je souhaite lister les valeurs qui apparaissent et dénombrer le nombre de fois qu'elles apparaissent dans les colonnes...

J'ai essayé à coups de RECHERCHEV mais c'est pas beau.
Je n'ai pas trouvé le moyen non plus par Tableau Croisé Dynamique
Et je suis une tanche en VBA...

Si vous avez des idées ou des solutions, je suis preneur
Merci par avance !

 

[Dugenou]

Bonjour,
je suis moi même ignorant en VBA, donc je te propose une approche par formule sur la base de ta façon de faire.
1) Limiter les plages de recherche à ce qui est utile : en écrivant :
RECHERCHEV($A3;'20180213'!A:A");1;FAUX) tu fais une recherche sur 1 400 000 lignes : pas étonnant que ça rame
avec RECHERCHEV($A3;'20180213'!A2:A200");1;FAUX) ou toute autre ligne (A2000) la plus élevée de ton tableau tu limites grandement l'utilisation des ressources !!
2)personnellement je suggère :
RECHERCHEV($A3;INDIRECT("'"&B$1&"'!A2:A200");1;FAUX) qui permet de gérer l'onglet utilisé avec le titre contenu dans la ligne 1. L'inconvénient et que cette formule ne se recopie que vers le bas. Il faut l'écrire une fois pour chaque colonne d'un onglet. Par contre ensuite tu peux copier coller à droite pour l'onglet suivant. On pourrai jouer avec le N° de colonne pour rendre variable la lettre de colonne mais bof

3)enfin pour le comptage on peut faire aussi plus concis avec :
=NB.SI.ENS($B3:$Y3;$A3;$B$2:$Y$2;Z$2&"*")
se recopie en bas et à droite

voir pj

Cordialement

 

[gosselien]

Bonjour,
quelle est ta version d'excel ?

P.

 

[damien2103]

Merci c'est un début

As tu une idée de comment faire pour extraire une liste de valeurs uniques à partir d'un tableau ?
(c'est à dire créer de manière dynamique la colonne A à partir des tableaux des onglets 20180213, 20180212, 20180209...)

je suis sous Excel 2010

 

[Dugenou]

Ben là ça va bouffer de la ressource ou bien ça va être merdique : une macro serait la bienvenue : je suis sur que Gosselien peut faire quelque chose pour toi pour obtenir cette première colonne

 

[damien2103]

j'ai trouvé un fichier (ci-joint) sur lequel il y a peut-être des idées à prendre même si la problématique n'est pas la même

 

[gosselien]

Ben là ça va bouffer de la ressource ou bien ça va être merdique : une macro serait la bienvenue : je suis sur que Gosselien peut faire quelque chose pour toi pour obtenir cette première colonne

C'est gentil @Dugenou , mais ça risque de me prendre 1 semaine...
Je vois qu'un dictionnaire (que je ne maîtrise toujours pas)peut aider c'est certain, mais j'essaye avec les outils 2016 pour le moment

P.

 

[klin89]

Bonsoir à tous,

Si la structure des données figurant dans chacune des feuilles à parcourir est identique, ceci devrait suffire.
Y a plus qu'à parcourir les feuilles concernées
On boucle sur les colonnes 1 à 5, puis 6 à 8

Option Explicit
Sub test()
Dim a, b(), i As Long, j As Long, n As Long, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    'attention a la 1ere dimension
    ReDim b(1 To 100, 1 To 3)
    n = 1: b(n, 2) = "signal A": b(n, 3) = "signal V"
    With Sheets("20180213").Range("a2").CurrentRegion
        a = .Value
        For i = 2 To UBound(a, 1)
            For j = 1 To 5
                If Not IsEmpty(a(i, j)) Then
                    If Not dico.exists(a(i, j)) Then
                        n = n + 1
                        b(n, 1) = a(i, j)
                        dico(a(i, j)) = n
                    End If
                    b(dico(a(i, j)), 2) = b(dico(a(i, j)), 2) + 1
                End If
            Next
            For j = 6 To 8
                If Not IsEmpty(a(i, j)) Then
                    If Not dico.exists(a(i, j)) Then
                        n = n + 1
                        b(n, 1) = a(i, j)
                        dico(a(i, j)) = n
                    End If
                    b(dico(a(i, j)), 3) = b(dico(a(i, j)), 3) + 1
                End If
            Next
        Next
    End With
    Application.ScreenUpdating = False
    With Sheets.Add().Cells(1).Resize(n, 3)
        .Value = b
        .Font.Name = "calibri"
        .Font.Size = 10
        .VerticalAlignment = xlCenter
        .BorderAround Weight:=xlThin
        .Borders(xlInsideVertical).Weight = xlThin
        With .Rows(1)
            .BorderAround Weight:=xlThin
            .HorizontalAlignment = xlCenter
        End With
    End With
    Set dico = Nothing
    Application.ScreenUpdating = True
End Sub

klin89

 

[damien2103]

Merci bcp Klin, ça fait le job !

 

[klin89]

Re damien2103,

Concernant les feuilles à traiter, dans ton cas, tu peux utiliser la propriété SelectedSheets, ça me parait plus judicieux et plus simple
Bon après c'est toi qui fixe les règles

Option Explicit
Sub test()
Dim a, b(), i As Long, j As Long, n As Long, dico As Object, ws As Worksheet
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    'attention a la 1ere dimension
    ReDim b(1 To 100, 1 To 3)
    n = 1: b(n, 2) = "signal A": b(n, 3) = "signal V"
    For Each ws In ActiveWindow.SelectedSheets
        With ws.Range("a2").CurrentRegion
            a = .Value
            For i = 2 To UBound(a, 1)
                For j = 1 To 5
                    If Not IsEmpty(a(i, j)) Then
                        If Not dico.exists(a(i, j)) Then
                            n = n + 1
                            b(n, 1) = a(i, j)
                            dico(a(i, j)) = n
                        End If
                        b(dico(a(i, j)), 2) = b(dico(a(i, j)), 2) + 1
                    End If
                Next
                For j = 6 To 8
                    If Not IsEmpty(a(i, j)) Then
                        If Not dico.exists(a(i, j)) Then
                            n = n + 1
                            b(n, 1) = a(i, j)
                            dico(a(i, j)) = n
                        End If
                        b(dico(a(i, j)), 3) = b(dico(a(i, j)), 3) + 1
                    End If
                Next
            Next
        End With
    Next
    Application.ScreenUpdating = False
    With Sheets.Add().Cells(1).Resize(n, 3)
        .Value = b
        .Font.Name = "calibri"
        .Font.Size = 10
        .VerticalAlignment = xlCenter
        .BorderAround Weight:=xlThin
        .Borders(xlInsideVertical).Weight = xlThin
        With .Rows(1)
            .BorderAround Weight:=xlThin
            .HorizontalAlignment = xlCenter
        End With
    End With
    Set dico = Nothing
    Application.ScreenUpdating = True
End Sub

klin89

 

[damien2103]

haha alors là c'est top, un grand merci c'est sympa d'être revenu dessus pour optimiser !
Merci bcp