me passer d'un tcd à cause de nombreuses lignes

[gosselien]

Bonjour,

On me demande un tableau résumé mais sans TCD vu le grand nombre de ligne et la vétusté du pc utilisé

Je propose donc de le faire gracieusement en VBA avec tableau et dictionnaire mais malgré tous mes efforts, je n'arrive pas à cause ma difficulté à comprendre les tableaux et dictionnaires (les plus attentifs le savent) alors que j'ai déjà su en faire mais là je rame(encore). Pour info, je ne suis pas informaticien , juste modeste passionné.

Le fichier en attaché montre une partie de la base, un résultat par TCD, le même copié en valeur mais je veux arriver à le faire tout pareil par dico dans la feuille "résultats"

Merci de votre aide et des explications dans le code si possible

P.

 

[Modeste geedee]

Re : me passer d'un tcd à cause de nombreuses lignes

Salut Patrick©...(*)
sans VBA , ni Dictionnaire...

pourquoi avoir cessé de cotiser à la SPA fondée par AV, le trésorier étant ton commensal "Jacquouille de Beaufays"
la "SommeProd Academy" est toujours à ton service ...

un Chirogourdiste inconditionnel ...

En AD5 :
=SOMMEPROD(($K2:$K100)*($P2:$P100=AD$4)*($E2:$E100=Ladate)*($S2:$S100=$AC5))
format de cellule :
0;;;

(*) contrepèterie...
https://fr.wiktionary.org/wiki/tricard

 

[Dranreb]

Re : me passer d'un tcd à cause de nombreuses lignes

Bonjour.

Voyez si ça convient.

 

[gosselien]

Re : me passer d'un tcd à cause de nombreuses lignes

Salut Patrick©...(*)
sans VBA , ni Dictionnaire...

pourquoi avoir cessé de cotiser à la SPA fondée par AV, le trésorier étant ton commensal "Jacquouille de Beaufays"
la "SommeProd Academy" est toujours à ton service ...

un Chirogourdiste inconditionnel ...

En AD5 :
=SOMMEPROD(($K2:$K100)*($P2:$P100=AD$4)*($E2:$E100=Ladate)*($S2:$S100=$AC5))
format de cellule :
0;;;

(*) contrepèterie...
https://fr.wiktionary.org/wiki/tricard

J'ai encore quelques contacts avec Jacqouille et je vois des réponses de AV de temps à autres mais je suis à présent sur ce forum et il n'y sont pas
J'ai bien pensé à un sommeprod mais pour ma culture qui avance à la vitesse d'une limace sous somnifère, mais je préfèrerais un dictionnaire pour sa vitesse, j'en utilise pour certains fichiers de ma compagne mais ici je ne sais pas adapter et je râle de ne pas savoir ...
Je sais que sommeprod ou un TCD iraient très bien mais j'avais testé des sommeprod sur quelques milliers de lignes et son pc ramait, alors que mon beau dico de l'époque flashait telle une porsche carerra gts, d'où l'idée de refaire ça ici.
Ces dico m'intéressent mais j'ai toujours autant de mal à les comprendre
Merci pour ton intérêt
Patrick

 

[gosselien]

Re : me passer d'un tcd à cause de nombreuses lignes

Bonjour Dranreb,

ça fonctionne bien sur mais c'est bien trop dur à comprendre pour ma culture; je sens là derrière un pur informaticien de haut vol (et c'est un compliment) mais si je devais adapter ou expliquer ton code j'en serais totalement incapable.
Le système avec dictionnaire que je tente est plus simple, plus court il ne me manque que 3 ou 4 lignes j'en suis sur, mais je tatonne , je tourne autour jusqu'au moment du "bon sang, mais c'est bien sûr"

Merci tout de même de ton implication !

P.

 

[mapomme]

Re : me passer d'un tcd à cause de nombreuses lignes

Bonjour gosselein, Dranreb,

Un essai avec un tableau, deux dictionary et un tableau de tableaux.

Deux options peuvent être inhibées par la mise en commentaire de leur code (voir en fin de de module):

• suppression des colonnes vides (pas de donnée pour une ville)
• suppression des lignes vides (pas de donnée pour une heure départ)

edit: à vouloir copier/coller trop vite, ça ne colle plus : remplacé le 2 par un 1 dans les bornes de la boucle optionnelle de suppression des colonnes vides -> v1a

 

[gosselien]

Re : me passer d'un tcd à cause de nombreuses lignes

Waouw...

Bonjour mapomme
code très documenté et commenté, je teste ça dès que possible mais un grand merci déjà !

Je vais tenter de le comprendre et de l'appliquer si mon fichier est pareil, j'avais reçu un exemple mais vous savez , les exemples sont parfois loin de de la réalité, mais, si je pige, j'adapte

Merci

P.

 

[mapomme]

Re : me passer d'un tcd à cause de nombreuses lignes

Re,

Une version v2 sans le tableau de tableaux qui rendait le code de la gestion des indices de la v1 quelque peu abscons.

 

[Dranreb]

Re : me passer d'un tcd à cause de nombreuses lignes

Bonjour.

Il ne faut pas du tout voir les choses comme ça, bien au contraire. En tant qu'informaticien je dis :
Pour faire un rapport genre tableau croisé dynamique il faut:
1) — Classer les données par critères de regroupement.
2) — Lire chaque élément dans cet ordre de classement, en faisant bien attention aux changements de valeurs des critères de regroupement. On appelle ça les ruptures de séquence.
Et c'est un truc fondamental, parce que c'est ce qui conditionne les moments ou il faut produire les totaux du critère qui vient de se terminer, puis faire leur remise à 0 en vue de calculer ceux de de sa nouvelle valeur. Sans oublier de faire aussi les totaux du tout dernier élément, alors qu'on n'a plus de rupture puisqu'on a fini de tout explorer.
Et c'est le bordel à programmer. Avec toujours le risque de traiter de travers le premier ou le dernier. Même pour un informaticien pas suffisamment chevronné quelquefois !

Alors je me suis dit un jour: "Qu'est-ce que je pourrais bien faire pour aider des non informaticiens à pouvoir facilement programmer des trucs comme ça sans se planter ?"

Et ma réponse: "Ben c'est très simple, je vais faire un outils qui résout tout seul à sa place tous les problèmes de classement et de test de rupture de séquence, et range tout proprement dans des collections emboîtées. Comme ça il n'aura plus qu'à faire des For Each In imbriqués pour l'explorer, ce qui est beaucoup plus simple."

Alors pour être franc, j'en ai un peu gros sur la patate que ma fonction GroupOrg soit perçue comme ça…

 

[klin89]

Re : me passer d'un tcd à cause de nombreuses lignes

Bonjour à tous,

Une autre version :

Option Explicit

Sub test()
Dim x, a, b(), i As Long, n As Long, pos
    With Sheets("F1").Cells(1).CurrentRegion
        a = .Value
        x = Filter(.Parent.Evaluate("transpose(if(countif(offset(" & .Columns(16).Address & _
            ",,,row(1:" & .Rows.Count & "))," & .Columns(16).Address & ")=1, " & _
            .Columns(16).Address & ",char(2)))"), Chr(2), 0)
        ReDim b(1 To .Rows.Count, 1 To UBound(x) + 1)
        b(1, 1) = "Heures/Ville"
        For i = 1 To UBound(x)
            b(1, i + 1) = x(i)
        Next
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For i = 2 To UBound(a, 1)
                If Not .exists(a(i, 19)) Then
                    .Item(a(i, 19)) = .Count + 2
                    b(.Item(a(i, 19)), 1) = a(i, 19)
                End If
                If a(i, 5) = Sheets(1).Range("V2").Value Then
                    pos = Application.Match(a(i, 16), x, 0)
                    b(.Item(a(i, 19)), pos) = b(.Item(a(i, 19)), pos) + a(i, 11)
                End If
            Next
            n = .Count + 1
        End With
    End With
    Application.ScreenUpdating = False
    'Restitution
    With Sheets("Résultats").Cells(1)
        .Parent.Cells.Clear
        .Resize(n, UBound(b, 2)).Value = b
        With .CurrentRegion
            .Font.Name = "calibri"
            .Font.Size = 10
            .VerticalAlignment = xlCenter
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            .Columns(1).NumberFormat = "hh:mm"
            With .Rows(1)
                .Interior.ColorIndex = 44
                .BorderAround Weight:=xlThin
                .HorizontalAlignment = xlCenter
            End With
            .Columns(1).ColumnWidth = 13
            For i = 2 To .Columns.Count
                .Columns(i).ColumnWidth = 10
            Next
            '.Columns("a:e").ColumnWidth = Array(13, 11, 11, 11, 11)
        End With
        .Parent.Activate
    End With
    Application.ScreenUpdating = True
End Sub

klin89

 

[gosselien]

Re : me passer d'un tcd à cause de nombreuses lignes

Re à tous,

je suis toujours surpris par la diversité des réponses proposées et leur justesse; le plus difficle étant de comprendre ligne par ligne pour éventuellement reproduire sur un même type de fichier

Un grand merci merci à tous !!!

 

[klin89]

Re : me passer d'un tcd à cause de nombreuses lignes

Re gosselien, le forum

Autre solution :
Si les heures de départ figurant en colonne S ne sont pas triées, tu peux les trier via un ArrayList.

Option Explicit
Sub test()
Dim a, i As Long, AL As Object, n As Long, e
    Set AL = CreateObject("System.Collections.ArrayList")
    a = Sheets("F1").Range("a1").CurrentRegion.Value
    With CreateObject("Scripting.Dictionary")
        For i = 2 To UBound(a, 1)
            If Not AL.Contains(a(i, 19)) Then AL.Add a(i, 19)
            If Not .exists(a(i, 16)) Then
                Set .Item(a(i, 16)) = _
                CreateObject("Scripting.Dictionary")
            End If
            If a(i, 5) = Sheets(1).Range("V2").Value Then
                .Item(a(i, 16))(a(i, 19)) = .Item(a(i, 16))(a(i, 19)) + a(i, 11)
            End If
        Next
        ReDim a(1 To AL.Count + 1, 1 To .Count + 1)
        AL.Sort
        For i = 0 To AL.Count - 1
            a(i + 2, 1) = AL(i)
        Next
        n = 1: a(1, 1) = "Heures/Ville"
        For Each e In .keys
            n = n + 1: a(1, n) = e
            For i = 2 To UBound(a, 1)
                If .Item(e).exists(a(i, 1)) Then
                    a(i, n) = .Item(e)(a(i, 1))
                End If
            Next
        Next
    End With
    Application.ScreenUpdating = False
    'Restitution
    With Sheets("Résultats").Cells(1)
        .Parent.Cells.Clear
        .Resize(AL.Count + 1, n).Value = a
        With .CurrentRegion
            .Font.Name = "calibri"
            .Font.Size = 10
            .VerticalAlignment = xlCenter
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            .Columns(1).NumberFormat = "hh:mm"
            With .Rows(1)
                .Interior.ColorIndex = 44
                .BorderAround Weight:=xlThin
                .HorizontalAlignment = xlCenter
            End With
            .Columns(1).ColumnWidth = 13
            For i = 2 To .Columns.Count
                .Columns(i).ColumnWidth = 12
            Next
        End With
        .Parent.Activate
    End With
    Application.ScreenUpdating = True
End Sub

klin89

 

[gosselien]

Re : me passer d'un tcd à cause de nombreuses lignes

Bonjour le forum, Klin89,

Je n'en demandais pas tant
Je me pencherai sur le bébé dès que possible, mais je sais que ce code conviendra et dans lequel il y a encore des choses dont j'ignorais l’existence (CreateObject("System.Collections.ArrayList"))

Merci !!!


P.