Discussion :

[mignane]

Bonsoir,
Je dispose d'un tableau à 2 entrées (X et Y). A l'intersection de chaque couple (X,Y) j'ai noté le nombre de fois que je rencontre ce couple. Donc il y a des couples pour lesquels la valeur à l'intersection est nulle. Pour exploiter mes données j'ai besoin de faire un autre tableau ou je récupère tous les couples dont l'intersection est non nul (voir exemple sur fichier joint). Est-ce que quelqu'un aurait une idée de comment je pourrai programmer ça sur vba (je suis un très grand débutant) sachant que la taille des tableaux peut être variable (tout dépends de l'échantillon choisi).
Merci d'avance

[Bear the french]

Bonsoir mignane,

Essaies cette macro et dis moi si ça te va.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub miseenforme2()
 
Dim x, y, nouv As Integer
 
nouv = 0
x = 1
y = 1
ReDim Tabl(14, 8) As Variant
For Each cell In Range("D4:K17")
    Tabl(x, y) = cell.Value
    If Tabl(x, y) <> 0 Then
            nouv = nouv + 1
            Cells(21, 3 + nouv).Value = Cells(3 + x, 3).Value
            Cells(22, 3 + nouv).Value = Cells(3, 3 + y).Value
            Cells(23, 3 + nouv).Value = Tabl(x, y) / Cells(3 + x, 12).Value
    End If
    y = y + 1
    If y = 9 Then
        y = 1
        x = x + 1
    End If
Next
 
End Sub

Ce code te place X, Y et l'occurrence sur ton tableau.

Bertrand

[mignane]

bonsoir bear,
ça fait des heuresque j'essaie de bidouiller ton code pour l'adapter à un cas plus général ( avec plus de données) mais ça ne marche pas. Si je veux généraliser cette mise en forme comment pourrai-je procéder.
Merci d'avance.

[Bear the french]

Bonjour Mignane,

1. Le code que je t'ai transmis fonctionne-t-il pour ton premier fichier ?

2. Quand tu veux dire "généraliser" le code : est ce que tu veux dire augmenter ou réduire la taille de ton tableau ?
Si c'est le cas, il vaudrait mieux mettre les résultats dans un nouvel onglet/feuille.
A voir les références de la cellule dans le coin supérieur gauche de ton tableau excel.
Sinon tu peux me dire où tu bloques dans la lecture du code.

Bertrand

[gFZT82]

Bonjour,

Dans le code suivant, j’ai repris l’idée de Bear the french et j’ai placé les résultats dans la feuille 2.
La taille du tableau peut varier (lignes ou colonnes) mais il faut conserver le coin haut-gauche du tableau de valeurs en D4.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Option Explicit
Sub miseenforme2()
Dim Ws2 As Worksheet
Dim NoLig As Long, Lig As Long
Dim NoCol As Integer
Dim Cel As Range
Dim Total As Double
    Lig = 2 'Numéro de la ligne d'en-tête de la feuille 2
    Application.ScreenUpdating = False
    Set Ws2 = Worksheets("Feuil2")
    'On efface les reports précédents en feuille 2
    Ws2.Range(Ws2.Range("A3:C3"), Ws2.Range("A3:C3").End(xlDown)).Delete Shift:=xlUp
    With Worksheets("Feuil1")
        NoLig = .Range("C4").End(xlDown).Row 'Dernière ligne du tableau de valeurs
        NoCol = .Range("D3").End(xlToRight).Column 'Dernière colonne du tableau de valeurs
        Total = .Cells(NoLig + 1, NoCol + 1).Value 'Total des valeurs
        For Each Cel In .Range(.Cells(4, 4), .Cells(NoLig, NoCol)) 'Plage correspondant au tableau des valeurs
            If Cel.Value <> 0 Then
                Lig = Lig + 1 'Ligne où sont reportés X, Y et l'occurence
                'Valeur de X
                Ws2.Cells(Lig, 1).Value = .Range("C" & Cel.Row)
                'Valeur de Y
                Ws2.Cells(Lig, 2).Value = Cells(3, Cel.Column)
                'Occurence
                Ws2.Cells(Lig, 3).Value = Cel.Value / Total
            End If
        Next
    End With
    'Mise en forme du tableau de report
    With Ws2.Range(Ws2.Range("A3:C3"), Ws2.Range("A3:C3").End(xlDown))
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End With
    Application.ScreenUpdating = True
    Set Ws2 = Nothing
End Sub

Cordialement.

[mercatog]

Dans le même ordre d'idée (code de gFZT82) en utilisant des variables tableaux (pour question de rapidité)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Dim NbCol As Integer, j As Integer, k As Integer
Dim NbLig As Long, i As Long
Dim Tot As Double
Dim Tb, Res()
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")
    NbLig = .Range("C4").End(xlDown).Row
    NbCol = .Range("D3").End(xlToRight).Column
    Tb = .Range(.Cells(3, 3), .Cells(NbLig, NbCol))
    Tot = Application.Sum(.Range(.Cells(4, 4), .Cells(NbLig, NbCol)))
End With
 
For i = 2 To UBound(Tb, 1)
    For j = 2 To UBound(Tb, 2)
        If Tb(i, j) <> "" Then
            k = k + 1
            ReDim Preserve Res(1 To 3, 1 To k)
            Res(1, k) = Tb(i, 1)
            Res(2, k) = Tb(1, j)
            Res(3, k) = Format(Tb(i, j) / Tot, "0.00%")
        End If
    Next j
Next i
If k > 0 Then
    With Worksheets("Feuil3")
        .UsedRange.Clear
        .Range("A1:C1") = Array("X", "Y", "Occ")
        .Range("A2").Resize(k, 3) = Application.Transpose(Res)
    End With
End If