Discussion :

[d0n32]

Bonjour à toutes et à tous,

J'ai la moitié inférieure d'une matrice, que je sais être symétrique. Je voudrais donc copier le contenu de chaque cellule non vide dans la cellule symétrique équivalente. Et je dois avouer que j'ai un peu de mal à gérer les adresses, et à voir comment trouver l'adresse de la cellule symétrique à celle sélectionnée..

Une idée s'il vous plait ?
Merci d'avance !

[Maxence HUBICHE]

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
Sub TraceSymetrie()
'---------------------------------------------------------------------------------------
' Procédure : TraceSymetrie
' Auteur    : Maxence HUBICHE (maxence_hubiche@1formaxion.com - http://www.1formaXion.com)
' Date      : 08/01/2011
' Objet     : Comment tracer la symétrie par rapport à une ligne d'une matrice.
'               La symétrie sera reproduite au-dessus de la sélection en cours
'---------------------------------------------------------------------------------------
'
    Dim lNumRow As Long     'Compteur pour le nombre de lignes à traiter
    Dim lNumCol As Long     'Compteur pour le nombre de colonnes à traiter
 
    'Pour chaque ligne de la sélection
    For lNumRow = 1 To Selection.Rows.Count
        'Pour chaque colonne de la sélection
        For lNumCol = 1 To Selection.Rows.Count
            'Si la cellule concernée n'est pas vide
            If Not IsEmpty(Selection.Cells(lNumRow, lNumCol)) Then
                'Ecrire sa valeur dans sa symétrie
                Selection.Range("A1").Offset(-lNumRow, lNumCol - 1).Value = Selection.Cells(lNumRow, lNumCol).Value
            'Sinon
            Else
                'la cellule est vide : rien à faire
            End If
        'colonne suivante
        Next
    'ligne suivante
    Next
'Fin du process
End Sub

[pgz]

Bonjour.

Une autre approche, en utilisant un tableau. On est bien d'accord :

• une matrice symétrique est carrée
• la diagonale va de haut-gauche à bas-droit.
• tu veux recopier le triangle du bas.

SI ok, je te propose, en utilisant un nom pour désigner la plage contenant la matrice. Je ne fais pas de distinction entre une cellule vide et une renseignée car dans tous les cas il faut conserver la symétrie.

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 subCompleteMatriceSymetrique()
Dim v As Variant, x As Integer, y As Integer
 
v = ThisWorkbook.Names("nmMatrSym").RefersToRange.Value
 
If UBound(v, 1) <> UBound(v, 2) Then GoTo lblErr1
 
For x = 2 To UBound(v, 1)
    For y = 1 To x
        v(y, x) = v(x, y)
    Next y
Next x
 
ThisWorkbook.Names("nmMatrSym").RefersToRange.Value = v
 
lblSortie:
    v = Empty
    Exit Sub
 
lblErr1:
    MsgBox "la matrice n'est pas carrée!"
    GoTo lblSortie
 
End Sub

Cordialement,

PGZ

[mercatog]

Et une autre approche

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
Sub Test()
Symetrisation Range("A1:E5"), Range("A7:E11")
End Sub
 
Sub Symetrisation(RngSrce As Range, RngDest As Range)
Dim M As String
 
If RngSrce.Rows.Count = RngSrce.Columns.Count Then
   If RngSrce.Rows.Count = RngDest.Rows.Count And RngSrce.Columns.Count = RngDest.Columns.Count Then
      M = RngSrce.Address(0, 0)
      With RngDest
         .FormulaArray = "=IF(" & M & "<>TRANSPOSE(" & M & ")," & M & "+TRANSPOSE(" & M & ")," & M & ")"
         .Value = .Value
      End With
   End If
End If
End Sub

[OrDonc]

Bonsoir

à essayer

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
 
Sub Sym()
  Dim d1 As Long 'nombre de lignes
  Dim L1 As Long, C1 As Long 'références première cellule du tableau
  Dim L As Long, C As Long 'variables de boucles
  Dim t 'tableau des valeurs symétriques, diagonale comprise
  d1 = Selection.Rows.Count
  If d1 = 1 Or Selection.Columns.Count = 1 Then Exit Sub 'rien si 1 ligne ou 1 colonne
  t = Application.Transpose(Selection)
  L1 = Selection.Row: C1 = Selection.Column
  For L = L1 To L1 + d1 - 1
    For C = C1 To C1 + d1 - 1
      If t(L - L1 + 1, C - C1 + 1) <> "" Then
        Cells(L, C) = t(L - L1 + 1, C - C1 + 1)
        Cells(L, C).Interior.ColorIndex = 3 'pour visualiser les ajouts
      End If
    Next
  Next
End Sub

[d0n32]

Merci !