XL 2016 Boucle dans une matrice

JONEY76

XLDnaute Occasionnel
Bonsoir à tous,

Je suis actuellement...bloqué!...
Je m'explique, j'ai une table de 50 colonnes par 50 lignes, dans laquelle je fais des calculs de corrélations entre des critères de 1 à 50. Je compare chaque critère, les uns par rapport aux autres.
J'ai fais une macro qui me donne le nombre de résultats supérieurs ou = à 0,90.

Pour cela, j'ai utilisé un For Each Cell in Range.

Par contre, mon blocage est le suivant:

Je souhaiterai pouvoir récupéré le nom du critère ainsi que le nom de sa correspondance avec la valeur.

Vous trouverez en pièce jointe un exemple avec une tableau de 10 colonnes par 10 lignes



Merci d'avance
 

Pièces jointes

  • Table corrélations.xlsm
    21.3 KB · Affichages: 26

Dranreb

XLDnaute Barbatruc
Bonsoir.
Comme ça je dirais :
VB:
Sub Lance()
Dim T(), L&, C&, TR(), LR&
T = ActiveSheet.[C6:M16].Value
ReDim TR(1 To 22, 1 To 3)
For L = 3 To UBound(T, 1)
   For C = 2 To L - 1
      If T(L, C) >= 0.9 Then
         LR = LR + 1
         TR(LR, 1) = T(1, C)
         TR(LR, 2) = T(L, 1)
         TR(LR, 3) = T(L, C): End If
      Next C, L
ActiveSheet.[B21:D42].Value = TR
End Sub
 

Modeste geedee

XLDnaute Barbatruc
Bonsour®
Bonsoir à tous,
Je m'explique, j'ai une table de 50 colonnes par 50 lignes, dans laquelle je fais des calculs de corrélations entre des critères de 1 à 50. Je compare chaque critère, les uns par rapport aux autres.
J'ai fais une macro qui me donne le nombre de résultats supérieurs ou = à 0,90.

Pour cela, j'ai utilisé un For Each Cell in Range.

Je souhaiterai pouvoir récupéré le nom du critère ainsi que le nom de sa correspondance avec la valeur.
upload_2018-11-6_0-29-22.png
 

Pièces jointes

  • Table corrélations.xlsm
    27.7 KB · Affichages: 25

JONEY76

XLDnaute Occasionnel
Bonsoir !

Merci beaucoup pour vos réponses !!
Du coup, j'ai essayé de mon coté aussi.. Mon code est plus long que celui de Dranreb... je n'ai vraiment pas ce niveau de syntaxe !

Code:
Sub lance()

'Déclarer mes variables
Dim cell As Range


'Remettre à zéro mes résultats
Range("a:a").Select
Selection.Clear

Range("b21:d200").Select

Selection.Clear


'Mettre A1 à 1
Range("a1").Value = 1

'Se mettre en cellule D7 = point de départ du tableau
Range("d7").Select



'Pour chaque cellule dans le tableau
For Each cell In Range("D7:m16")

Dim ligne As Integer
Dim colonne As Integer
cell.Select

ligne = ActiveCell.Row
colonne = ActiveCell.Column

Range("d2").Value = ligne
Range("e2").Value = colonne

'si la valeur de la cellule est supérieure à 0.9 alors on appelle la procédure collage
If cell.Value >= 0.9 Then Call collagE

'cellule suivante
Next cell


Range("a1").Value = Range("a1").Value - 1

End Sub
Sub collagE()
Dim x As Integer
Dim ligne As Integer
Dim colonne As Integer

ligne = ActiveCell.Row
colonne = ActiveCell.Column

Range("d2").Value = ligne
Range("e2").Value = colonne



'appliquer un résultat incrémenté en a1
x = Range("a1").Value


Range("a1").Value = Range("a1").Value + 1

'Lister les résultats obtenus
Range("a20").Offset(x, 0).Select
Selection.Value = "résultat " & x
ActiveCell.Offset(0, 1).Select

ActiveCell.Value = ActiveCell.Offset(-14 - x, colonne - 2).Value

ActiveCell.Offset(0, 1).Select
ActiveCell.Value = ActiveCell.Offset(-20 - x + ligne, 0).Value


ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Range("a1").Offset(ligne - 1, colonne - 1).Value





Je viens de regarder le fichier de Modeste, merci beaucoup !
Du coup, nous arrivons au même résultats mais mon code est moins épuré...

Merci à vous deux en tout cas !!!
 

cp4

XLDnaute Barbatruc
Bonjour Joney76, Modeste geedee, Dranreb, le forum,

Ton code met beaucoup de temps car tu utilises trop de select qui ne servent qu'à ralentir ton code.

J'ai complété le code de Dranreb (le plus rapide) pour que tu aies le résultat comme tu le souhaitais.
VB:
Option Explicit
Sub Lance()
   Dim T(), L&, C&, TR(), LR&
   T = ActiveSheet.[C6:M16].Value
   'ReDim TR(1 To 22, 1 To 3)
   ReDim TR(1 To 22, 1 To 4)

   For L = 3 To UBound(T, 1)
      For C = 2 To L - 1
         If T(L, C) >= 0.9 Then
            LR = LR + 1
            TR(LR, 1) = "résultat" & LR
            TR(LR, 2) = T(1, C)
            TR(LR, 3) = T(L, 1)
            TR(LR, 4) = T(L, C)
         End If
      Next C, L

      ActiveSheet.[A21:D42].Value = TR   'report sur la feuille
   End Sub
Bonne journée.
 

Modeste geedee

XLDnaute Barbatruc
Bonsour®
Ton code met beaucoup de temps car tu utilises trop de select qui ne servent qu'à ralentir ton code.
:rolleyes:
Plus rapide, plus concis, plus simple, plus clair dites-vous ???
VB:
Sub lance()
Dim cell As Range, x As Integer
Application.Calculation = xlCalculationManual
[A9] = Now
Range("a20:d50").Clear '----------------------------------------Reinitialisation résultats
Application.ScreenUpdating = False
x = 0
For Each cell In Range("D7:m16") '---------------------Pour chaque cellule dans le tableau
        If cell.Value >= [D1] Then '-------------si valeur de la cellule supérieure à [D1]
            x = x + 1 '----------------------------------------incrémentation nb résultats
            With Range("a19") '-------------------------------alors on inscrit le résultat
                    .Offset(x, 0).Value = "résultat " & x
                    .Offset(x, 1) = Cells(cell.Row, 3)
                    .Offset(x, 2) = Cells(6, cell.Column)
                    .Offset(x, 3) = Cells(cell.Row, cell.Column)
            End With
        End If
Next cell
Application.ScreenUpdating = True
[B9] = Now
End Sub
upload_2018-11-6_10-54-27.png


:cool::p:rolleyes:
 

Pièces jointes

  • Table corrélations (1).xlsm
    31.7 KB · Affichages: 18

Discussions similaires

Statistiques des forums

Discussions
311 733
Messages
2 082 015
Membres
101 870
dernier inscrit
Dethomas