Créer matrice d'occurrence à partir tableau

Re,

je ne peux pas t'aider à réaliser ta macro

une âme charitable va surement passer par là pour t'aider

Bonne chance

R@chid a écrit :

Re,

je ne peux pas t'aider à réaliser ta macro

une âme charitable va surement passer par là pour t'aider

Bonne chance

Merci beaucoup en tout cas !

espérant !!

Cdt

Bonjour à tous...

J'espère que Pwetzou excusera mon intrusion...

Saisi par zaudix (en MP) pour bâtir une procédure passant directement d'un Tableau construit similairement au Tableau 1 de ce sujet à un Tableau correspondant au Tableau 4 de ce sujet, j'y ai procédé...

Entretemps, zaudix a ouvert un sujet à partir du même Tableau, sujet avec lequel pour ma part je ne vois pas de point commun avec la demande formulée ici.

Je me permets donc de placer ma réponse à sa demande dans ce sujet où elle me paraît le plus à sa place.

Sub DénombrerLiensFonctions()
    Dim TF(), dp As Object, df As Object, ff, kp, x, n%, k%, i%, j%
    ''Bornage' du tableau source
    With ActiveSheet
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        k = .Cells(1, .Columns.Count).End(xlToLeft).Column
        'Répertoire des 'fonctions' par 'produit' (dico dp)
        Set dp = CreateObject("Scripting.Dictionary")
        For i = 2 To n
            For j = 2 To k
                If .Cells(i, j) = 1 Then ff = ff & ";" & .Cells(1, j)
            Next j
            If ff <> "" Then dp(.Cells(i, 1).Value) = ff
            ff = ""
        Next i
        'Répertoire des associations de 'fonctions' (dico df, à partir du précédent)
        Set df = CreateObject("Scripting.Dictionary")
        For Each kp In dp.keys
            ff = Split(dp(kp), ";")
            If UBound(ff) > 1 Then
                For j = 1 To UBound(ff)
                    x = ff(j): ff(j) = ff(1): ff(1) = x
                    For i = 2 To UBound(ff)
                        If df.exists(ff(1) & "|" & ff(i)) Then
                            df(ff(1) & "|" & ff(i)) = CInt(df(ff(1) & "|" & ff(i))) + 1
                        Else
                            df(ff(1) & "|" & ff(i)) = 1
                        End If
                    Next i
                Next j
            End If
        Next kp
    End With
    'Dimensionnement du tableau résultats
    ReDim TF(1 To df.Count, 1 To 3)
    'Transfert des associations répertoriées dans le tableau
    i = 0
    For Each x In df.keys
        i = i + 1
        TF(i, 1) = x
    Next x
    'Tri du tableau résultats
    For i = 1 To UBound(TF, 1) - 1
        For j = i + 1 To UBound(TF, 1)
            If TF(j, 1) < TF(i, 1) Then
                x = TF(j, 1): TF(j, 1) = TF(i, 1): TF(i, 1) = x
            End If
        Next j
    Next i
    'Mise à jour du tableau résultats
    For i = 1 To UBound(TF, 1)
        TF(i, 3) = CInt(df(TF(i, 1)))
        ff = Split(TF(i, 1), "|")
        TF(i, 1) = ff(0): TF(i, 2) = ff(1)
    Next i
    'Ajout d'une feuille résultat et transfert tableau sur la feuille
    ' et mise en forme
    Application.ScreenUpdating = False
    With Worksheets.Add(after:=ActiveSheet)
        With .Range("A1").Resize(UBound(TF, 1), 3)
            .Value = TF
            .HorizontalAlignment = xlCenter
            With .Borders
                .LineStyle = xlContinuous
                .Weight = xlThin
            End With
        End With
    End With
End Sub

Codialement.

Salut,

Bah c'est bon boulot ce code...

L'ancien que j'avais obtenu sur ce forum, je l'ai utilisé toutes les semaines depuis, mais celui-ci est peut-être plus directe et opérationnel.

Je suis en train de retranscrire une version en Python pour traiter des fichiers .txt directement, et plus avoir à passer par excel.. à mon avis on peut gagner en simplicité.

@+ !

G.

Bonjour,

Merci beaucoup MFerrand !

c'est exactement ce que je voulais !