Microsoft 365 Méthode Evaluate pour se dispenser d'une boucle imbriquée

[klin89]

Bonjour le forum,

Je me résous à vous exposer mon problème faute d'une solution trouvée
Dans le tableau, les colonnes A et b contiennent des valeurs (nombres décimaux ou entiers) non triés.
En colonne C, j'aimerais renvoyer pour chaque valeur de le colonne A, la valeur de la colonne B supérieure à A en étant la plus proche.

C'est ce que réalise la macro ou la formule matricielle située en colonne E

=SI(A2="";"";SI(MIN(SI(B$2:B$14>A2;B$2:B$14))=0;"";MIN(SI(B$2:B$14>A2;B$2:B$14))))

Sub test()
    Dim a, i As Long, ii As Long
    Dim minValue As Double, flag As Boolean
    With Sheets("Feuil1")
        a = .Range("A1").CurrentRegion.Value
        For i = 2 To UBound(a, 1)
            If IsNumeric(a(i, 1)) And Not IsEmpty(a(i, 1)) Then
                minValue = 0
                flag = False
                For ii = 2 To UBound(a, 1)
                    If IsNumeric(a(ii, 2)) And a(ii, 2) > a(i, 1) Then
                        If Not flag Or a(ii, 2) < minValue Then
                            minValue = a(ii, 2)
                            flag = True
                        End If
                    End If
                Next
                If flag Then a(i, 3) = minValue
            End If
        Next
        .Range("G1").Resize(UBound(a, 1), UBound(a, 2)).Value = a
    End With
End Sub

Or j'essaie à travers cette autre code et la méthode Evaluate, de me passer de la boucle imbriquée du précédent code en y insérant la formule, mais je n'y arrive pas

Sub test()
    Dim a, b, i As Long, ii As Long
    'SI(MIN(SI(B$2:B$14>A2;B$2:B$14))=0;"";MIN(SI(B$2:B$14>A2;B$2:B$14)))
    With Sheets("Feuil1").Range("A1").CurrentRegion
        a = .Value
        'b represente la colonne 2
        b = Application.Transpose(Application.Index(.Value, Evaluate("row(2:" & .Rows.Count & ")"), 2))
        'b = Application.Index(.Value, Evaluate("row(2:" & .Rows.Count & ")"), 2)
        For i = 2 To UBound(a, 1)
            If IsNumeric(a(i, 1)) And Not IsEmpty(a(i, 1)) Then
                a(i, 3) = Application.Evaluate("IF(MIN(IF(" & b & ">" & a(i, 1) & "," & b & "))=0,"""",MIN(IF(" & b & ">" & a(i, 1) & "," & b & ")))")
            End If
        Next
        .Range("G1").Resize(UBound(a, 1), UBound(a, 2)).Value = a
    End With
End Sub

Peut-être fais-je fausse route, pouvez-vous venir à mon aide
klin89

 

[sylvanu]

Bonsoir Klin
En dehors d'Evaluate, on peut le faire sans boucle avec :

Sub Test2()
Dim Formule$
Formule = "=IF($G2="""","""",IF(MIN(IF(H$2:H$14>$G2,H$2:H$14))=0,"""",MIN(IF(H$2:H$14>$G2,H$2:H$14))))"
[G2:H14] = [A2:B14].Value
[I2].FormulaArray = Formule
[I2].AutoFill Destination:=Range("I2:I14"), Type:=xlFillDefault
[I2:I14] = [I2:I14].Value
End Sub

 

[jurassic pork]

Hello,
la fonction existe déjà dans Excel 366 :

Ami calmant, J.P

 

[klin89]

Salut sylvanu, jurassic pork

Merci pour vos réponses,
Dans un autre projet, étant donné que j'utilise des variables sous forme de tableaux, je pensais pouvoir récupérer directement, sans boucle, la valeur correspondante à a(i,1) dans le vecteur b (ici b(9)), en utilisant Evaluate.

Je crois que je me suis bien planté sur ce coup là
Après s'il y a une solution sans Evaluate, je suis preneur ...

Edit : jurassic pork, tu viens de me faire découvrir cette nouvelle fonction que je ne connaissais pas

klin89

 

[patricktoulon]

bonsoir en validant (une seul cellule en matriciel pour le looping de comparaison >= et min et en étendant la formule après on est bon avec ceci
tape ça en cellule C2

=SI(A2<>"";SIERREUR(MIN(SI(B$2:B$14>=A2;B$2:B$14));0);"")

valide en matriciel
et etend la formule

explication:

=SI(A2<>"";                                     ' si A2 est pas vide'
          SIERREUR(                                'gestion d'erreur
                 MIN(                            'minimum'
                    SI(B$2:B$14>=A2;B$2:B$14)    'matrice de 14 lignes se repetant 14 fois pour la ligne de A2'
                    );                            'fin de MIN'
            0);                                    'zero si erreur et fin de gestion d'erreur
;"")                                            ' rien si A2 est vide '

Attention ne pas confondre matriciel et matrice de descendant

C1:C14 validé en matriciel=matriciel répété (14 puissance 14) par ligne
donc pour A2 on trouvera 104.8et même pour ailleurs(pas bon)
c2 validé en matriciel=matrice de d descendant répété 14 fois par ligne
on trouvera le min de tout les plus grand que A2

 

[jurassic pork]

Edit : jurassic pork, tu viens de me faire découvrir cette nouvelle fonction que je ne connaissais pas

Hello Klin89,
en fait c'était un canular et je pense qu'Excel 366 n'existe pas. En fait j'ai utilisé un Addin xll avec du code écrit dans un autre langage que le VBA. Avec cet Addin je peux même créer des fonctions comme Sequence pour des versions d'Excel qui ne l'ont pas.
Ami calmant, J.P

 

[patricktoulon]

Bonjour @jurassic pork
oui oui oui oui je veux je veux je veux moi moi moi
sequence ,filtre, jointexte,unique
merci jurassic papa noel

 

[jurassic pork]

Exemple pour Sequence avec Excel 2016:

 

[patricktoulon]

ouoi oui oui je veux je veux

 

[jurassic pork]

Pour l'instant il est en phase expérimentale mais si cela intéresse pas mal de monde je pourrais le mettre en partage. Dedans il y a aussi un timer sécurisé, des procédures que l'on peut appeler depuis le VBA ( presse-papier (tout type de contenu), powershell, runcmd (équivalent de shell mais plus rapide et sans fenêtre de console) etc... Il utilise ExcelDna qui permet de faire le "pont" entre VBA et dotnet. La taille de l' addin est d'environ 700ko . On peut générer une version 32 bits et une version 64 bits. Il utilise le framework dotnet 4.x qui est présent par défaut sur toutes les versions de windows depuis windows 7

 

[patricktoulon]

une fonction alea sans doublons aussi ca ça serait une idée
ben ouvre un topic dans les ressources et tu verra bien
moi je suis intéressé en tout cas
je vais finir par m'y mettre au dot net

 

[patricktoulon]

RE

Sub testevaluateprime()
'originalformule enregistrée   "=IF(Rc[-2]<>"""",IFERROR(MIN(IF(R2C[-1]:R14C[-1]>=RC[-2],R2C[-1]:R14C[-1])),0),"""")")
'evaluate ne fonctionne pas en addressage RC
'traduction en formule noN RC
MsgBox Evaluate("=IF(A2<>"""",IFERROR(MIN(IF(B2:B14>=A2,B2:B14)),0),"""")")
End Sub

'CONVERSION EN FONCTION UTILISABLE EN FORMULE

Sub testfunction()
MsgBox NearGreatestValue([A2], [b2:b14])
End Sub

Function NearGreatestValue(rng1 As Range, RnG2 As Range)
NearGreatestValue = Evaluate("=IF(" & rng1.Address(0, 0) & "<>"""",IFERROR(MIN(IF(" & RnG2.Address(0, 0) & ">=" & rng1.Address(0, 0) & "," & RnG2.Address(0, 0) & ")),0),"""")")
End Function

formule en C2

=NearGreatestValue(A2;B2:B14)

et étendre la formule vers le bas

 

[jurassic pork]

Il y a un excellent article sur la fonction Evaluate ici ( en angliche)

 

[patricktoulon]

re
@jurassic pork un peu leger je trouve
bon il y la base
mais c'est vrai que evaluate depuis 2007 a beaucoup été dépréciée
on trouve des bon tyuaux sur des sites chinois généralement

mais evaluate peut être utilisé de différentes manières et pour d'autre chose qu'une conversion vba de fonction excel

j'avais fait des pdfs qui allaient un peu plus loin
par exemple au niveau des bases
la création de matrice 2d ou 1d ordered ou unordered très utile pour des unordered transpositions
tiens si ça t'intéresse j'avais réussi e les récupérer sur mon compte DVP je les avais déjà donné mais je retrouve plus le post sur exceldownloads
malheureusement je n'ai pas pu récupérer toute la serie que j'avais faites mais on vois quand même qu'il y a des possibilités autres qu'une simple utilisation de formule par evaluate
dans ce classeur que j'ai fait vite fait comme ça vous avez un exemple de transposition unordered
Patrick

 

[patricktoulon]

je parle de unordered et je vous donne pas un exemple
récupération de partie du tableau non contigues et dans le desordre

Sub exemple6()
    Dim matriceLigne
    Dim Matricecolonne()
    Dim montableau
    Dim monNewtableau
    montableau = [A1:H10].Value
    matriceLigne = Evaluate("{8;4;1;7}")
    Matricecolonne = Evaluate("{8,3,6,2}")
    monNewtableau = Application.Index(montableau, matriceLigne, Matricecolonne)

   Cells(1, 12).Resize(UBound(monNewtableau), UBound(monNewtableau, 2)) = monNewtableau
End Sub