Microsoft 365 Comment récupérer l'adresse d'une cellule dans une variable tableau ?

[DanB34]

Bonjour,
Dans une variable tableau, je cherche à récupérer l'adresse d'une cellule contenant en fonction de sa valeur.
Ex. avec les nombres ci-dessous de A1 à D10
Si la somme des col. A + B est > C + D -> récupération de l'adresse (pas sur la feuille Excel, mais dans la var tableau Tb)

14​	29​	30​	27​
26​	44​	19​	11​
70​	6​	90​	18​
90​	62​	86​	69​
50​	37​	37​	61​
84​	18​	42​	31​
67​	53​	37​	39​
74​	13​	25​	65​
5​	53​	84​	92​
80​	65​	93​	65​

Sub Test_Adresses()
Dim FD, Tb As Variant
Dim CelDep As String, CelArv As String, CelTabDep As String, CelTabArv As String
Dim Cpt As Long, Cpt2 As Long
Dim Calc1 As Integer, Calc2 As Integer

    Set FD = Worksheets("Feuil1")
    DerLigne = FD.Range("A999999").End(xlUp).Row

    CelDep = Range("A1").Address
    CelArv = Range("A1:D" & DerLigne).Address
    Tb = FD.Range(CelDep & ":" & CelArv)
    
'Teste si la somme des cellules des colonnes A + B et bien < à la somme des cellules des colonnes C + D
'Si ce n'est pas le cas, récupération de l'adresse - de la var tableau - de la cellule de la Col. A + n° de ligne
'et de l'adresse de la cellule de la col. D + n° de ligne
    Cpt = 0
    Cpt2 = 0
    For I = LBound(Tb, 1) To UBound(Tb, 1)
        Calc1 = Tb(I, 1) + Tb(I, 2)
        Calc2 = Tb(I, 3) + Tb(I, 4)
        If Calc1 > Calc2 Then
            Cpt = Cpt + 1
            CelTabDep = Cells(Tb(I, 1)).Address
            CelTabArv = Cells(Tb(I, 2)).Address
        End If
    Next
    Erase Tb
End Sub

Les variables CelTabDep et CelTabArv affichent des résultats bizarres $Z$1 et $AR$1 pour la ligne n° 2 (1ère ligne qui remplit les conditions).
Merci d'avance pour l'aide et le temps passé
Bonne journée
Dan

 

[fanch55]

Salut, il y a un problème de logique :
CelTabDep = Cells(Tb(I, 1)).Address

Tu récupères l'adresse de la cellule n° Tb(i,i) de ta feuille ..., c'est à dire la cellule 26 qui est bien $Z$1.
Il doit manquer des instructions dans le code fourni sinon à quoi servent les compteurs cpt et cpt2 ?

 

[mapomme]

Bonjour @DanB34,

La propriété Cells nécessite deux paramètres : un numéro de ligne et un numéro ou lettres de colonne. A ce que je sache Tb ne contient pas de telles informations mais juste des valeurs.
L'information de ligne est corrélée à l'indice de boucle i.
L'indice de colonne, c'est soit A soit D.

Essayez :

Sub Test()
Dim t, i&, AddrA$, AddrD$
   t = Range("a1").CurrentRegion
   For i = 1 To UBound(t)
      If t(i, 1) + t(i, 2) > t(i, 3) + t(i, 4) Then
         AddrA = "A" & i: AddrD = "D" & i
         MsgBox "Cellules  : " & AddrA & " : " & AddrD
         Exit Sub
      End If
   Next i
   MsgBox "Aucune ligne hors de la condition"
End Sub

 

[laurent950]

Bonjour à tous,
Ici l'adresse n'est pas mise dans une variable tableau :
Plage de test avec des valeur en F18:I27

Sub test()
Dim FD As Worksheet
    Set FD = Worksheets("Feuil1")
Dim TbAdr As Range
    Set TbAdr = FD.Range("F18:I" & FD.Range("F999999").End(xlUp).Row)
Dim TbBis() As Variant
    TbBis = TbAdr.Value
Dim Calc1 As Integer, Calc2 As Integer
'Teste si la somme des cellules des colonnes A + B et bien < à la somme des cellules des colonnes C + D
'Si ce n'est pas le cas, récupération de l'adresse - de la var tableau - de la cellule de la Col. A + n° de ligne
'et de l'adresse de la cellule de la col. D + n° de ligne
    For I = LBound(TbBis, 1) To UBound(TbBis, 1)
        Calc1 = TbBis(I, 1) + TbBis(I, 2)
        Calc2 = TbBis(I, 3) + TbBis(I, 4)
        If Calc1 > Calc2 Then
            CelTabDep = TbAdr(I, 1).Address: TbAdr(I, 1).Select
            CelTabArv = TbAdr(I, 2).Address: TbAdr(I, 2).Select
        Else
            CelTabDep = TbAdr(I, 3).Address: TbAdr(I, 3).Select
            CelTabArv = TbAdr(I, 4).Address: TbAdr(I, 4).Select
        End If
    Next I
    Erase TbBis
    Set TbAdr = Nothing
    Set FD = Nothing
    Calc1 = Empty: Calc2 = Empty
End Sub

 

[jmfmarques]

Bonjour à tous
On peut également "jouer" avec la notation interne des cellules d'une plage.
exemple :

Set t = Range("A1").CurrentRegion
For k = 1 To t.Count Step t.Columns.Count
  If t(k) & t(k + 1) > t(k + 2) + t(k + 3) Then MsgBox t(k).Address & vbCrLf & t(k + 3).Address
Next

cet exemple uniquement pour montrer (les adresses à montrer sont à adapter)

 

[laurent950]

Re Bonjour à tous,
Maintenant l'adresse est dans une variable tableau :
Plage de test avec des valeur en F18:I27

Sub test()
Dim FD As Worksheet
    Set FD = Worksheets("Feuil1")
Dim TbAdr As Range
    Set TbAdr = FD.Range("F18:I" & FD.Range("F999999").End(xlUp).Row)
Dim TbBis(1 To 2) As Variant
        TbBis(1) = TbAdr.Value
    Set TbBis(2) = TbAdr
Dim Calc1 As Integer, Calc2 As Integer
' Libére la mémoire (Puisque cela est dans une variable tableau)
    Set TbAdr = Nothing
'Teste si la somme des cellules des colonnes A + B et bien < à la somme des cellules des colonnes C + D
'Si ce n'est pas le cas, récupération de l'adresse - de la var tableau - de la cellule de la Col. A + n° de ligne
'et de l'adresse de la cellule de la col. D + n° de ligne
    For I = LBound(TbBis, 1) To UBound(TbBis, 1)
        Calc1 = TbBis(1)(I, 1) + TbBis(1)(I, 2)
        Calc2 = TbBis(1)(I, 3) + TbBis(1)(I, 4)
        If Calc1 > Calc2 Then
            TbBis(2)(I, 1).Select: MsgBox TbBis(1)(I, 1)
            TbBis(2)(I, 2).Select: MsgBox TbBis(1)(I, 2)
        Else
            TbBis(2)(I, 3).Select: MsgBox TbBis(1)(I, 3)
            TbBis(2)(I, 4).Select: MsgBox TbBis(1)(I, 4)
        End If
    Next I
' Libére la mémoire
    Erase TbBis
    Set FD = Nothing
    Calc1 = Empty: Calc2 = Empty
End Sub

Variable tableau avec Valeur et Range pour retrouver les positions dans la feuille
laurent950

 

[DanB34]

Merci à :
- fanch55
- mapomme
- laurent950
- jmfmarques

Je vais conserver la solution de mapomme qui est courte, mais que je comprends.
Toutes vos propositions m'ont apporté des idées et des informations très intéressantes.
Très cordialement,
Dan

 

[mapomme]

Re,

On peut se servir d'un tableau à une dimension. Ce tableau comporterait les numéros de ligne des lignes qui ne vérifient pas la condition. A partir des numéros de lignes, on reconstitue facilement les adresses désirées. Voir le code suivant avec commentaires.

Sub Test()
Dim t, i&, n&, TabLigne(), s

   ' ----->  construction du tableau des lignes avec anomalie
   ReDim Preserve TabLigne(0 To 0)     ' on crée le tableau résultat à une dimension avec un indice commeçant à zéro
   t = Range("a1").CurrentRegion       ' lecture des valeurs
  
   For i = 1 To UBound(t)     ' boucle sur les lignes de t
      If t(i, 1) + t(i, 2) > t(i, 3) + t(i, 4) Then
         ' la condition d"sirée n'est pas vérifiée
         n = n + 1      'on incrémente le nombre de lignes concernées
         ' si n = 1, c'est le premier élément. On redimensionne le tableau résultat à un élément
         '        mais cette fois ci l'indice de base est 1
         ' si n > 1, Il y a déjà des éléments. On redimensionne le tableau résultat à n élément
         '        mais cette on garde l(indice de base 'et les valeurs déjà présentes)
         If n = 1 Then ReDim TabLigne(1 To 1) Else ReDim Preserve TabLigne(1 To n)
         TabLigne(UBound(TabLigne)) = i   'on rajoute la ligne au dernier élément deu tablreau qu'on vient de créé
      End If
   Next i

  
   'Exemple d'utilisation de Tabligne
   If LBound(TabLigne) = 0 Then
      ' si l'indice de base du tableau est 0, cela signifie qu'on y a mis aucun numéro de ligne
      MsgBox "Aucune ligne hors de la condition"
   Else
      ' si l'indice de base du tableau est 1, cela signifie qu'on y a mis au moins un numéro de ligne
      ' En tout, on y a même mis Ubound(TabLigne) numéros de lignes
      s = UBound(TabLigne) & " cellules concernées : " & vbLf
      For i = 1 To UBound(TabLigne)
         s = s & vbLf & Space(11) & Cells(TabLigne(i), "A").Address(0, 0) & " à " & Cells(TabLigne(i), "D").Address(0, 0)
      Next i
      MsgBox s
   End If
End Sub

 

[laurent950]

Sub Test() Dim t, i&, AddrA$, AddrD$ t = Range("a1").CurrentRegion For i = 1 To UBound(t) If t(i, 1) + t(i, 2) > t(i, 3) + t(i, 4) Then AddrA = "A" & i: AddrD = "D" & i MsgBox "Cellules : " & AddrA & " : " & AddrD Exit Sub End If Next i MsgBox "Aucune ligne hors de la condition" End Sub

@mapomme le code fonctionne si la matrice est bien en "A1:H18" pour le CurrentRegion mais si la matrice est en "F18:I27" comment cela fonctionne ?

 

[mapomme]

Bonsoir @laurent950

@mapomme le code fonctionne si la matrice est bien en "A1:H18" pour le CurrentRegion mais si la matrice est en "F18:I27" comment cela fonctionne ?

CurrentRegion fonctionne bien si la plage "visée" est isolée :

• une colonne vide ou pas de colonne à droite
• une colonne vide ou pas de colonne à gauche
• une ligne vide ou pas de colonne en haut
• une ligne vide ou pas de colonne en bas

CurrentRegion est l'équivalent au clavier : se placer A1 et taper Ctrl+*
Donc si la plage F18:I27 répond à ces conditions, Range("F18").CurrentRegion fonctionne sinon...

En dehors de ce cas trivial, il faut s'adapter à la configuration réelle et c'est différent suivant qu'il existe ou non des colonnes à droite ou à gauche de la plage, qu'il existe ou non des lignes au-dessus ou en-dessous de la plage, si la plage comporte ou non des lignes ou colonnes vides; etc.

Il n'y a pas de méthode générale.

nota : Souvent, on part d'une base de données importée qui a été placée par l'importation en A1 avec une première ligne d'en-têtes et une première colonne de références. Et dans ce cas CurrentRegion fonctionne bien.

 

[laurent950]

Re,
@mapomme avec cette matrice "F18:I27" le résultat avec : t = Range("F18").CurrentRegion
26+44 est plus grand que 19+11 (Mais l'adresse n'est pas bonne !)
Avec code Poste #3

 

[laurent950]

Re,
@mapomme avec cette matrice "F18:I27" le résultat avec : t = Range("F18").CurrentRegion
26+44 est plus grand que 19+11 (Mais l'adresse n'est pas bonne !)
Avec code Poste #8

 

[mapomme]

(Mais l'adresse n'est pas bonne !)

C'est tout à fait normal.

La ligne 1 du tableau t correspond à la ligne 18 de la feuille Excel (et non pas à la ligne 1 quand la plage commençait en A1) ==> donc il faut rajouter à i la valeur 17.

De même, La dernière colonne de la plage est I (et non pas la colonne D quand la plage commençait en A1).

On écrira :
AddrA = "F" & i + 17 : AddrD = "I" & i + 17

 

[fanch55]

salut @mapomme , @laurent950 ,
une joute sur un sujet résolu ?
je ne suis pas sûr du ressorti, c'est pointu

 

[laurent950]

Re
@mapomme , @fanch55
l'astuce c'est :
* une tableau à 1 dimension qui contient 2 cases (0 et 1)
* Case 0 = on injecte les valeurs de la matrice
* Case 1 = on injecte la plage Range (L'objet)
* Donc les Positions relatif et Absolu sont contenu dans la variable tableau 1 Dimension mais qui contient deux Matrice (Une matrice avec que des valeurs et une matrice avec la plage range)
* Comment vous trouver cette Astuce ?

Code

Sub test()
Dim FD As Worksheet
    Set FD = Worksheets("Feuil1")
Dim TbBis(1 To 2) As Variant
        TbBis(1) = FD.Range("F18:I" & FD.Range("F999999").End(xlUp).Row).Value
    Set TbBis(2) = FD.Range("F18:I" & FD.Range("F999999").End(xlUp).Row)
    For i = LBound(TbBis(1), 1) To UBound(TbBis(1), 1)
        If TbBis(1)(i, 1) + TbBis(1)(i, 2) > TbBis(1)(i, 3) + TbBis(1)(i, 4) Then
            'TbBis(2)(i, 1).Select: MsgBox TbBis(1)(i, 1)
            'TbBis(2)(i, 2).Select: MsgBox TbBis(1)(i, 2)
            s = s & vbLf & Space(11) & TbBis(2)(i, 1).Address(0, 0) & " à " & TbBis(2)(i, 2).Address(0, 0)
        End If
    Next i
    MsgBox s
' Libére la mémoire
    Erase TbBis
    Set FD = Nothing
    Calc1 = Empty: Calc2 = Empty
End Sub