XL 2019 Tableau index vers valeur

Hoareau · 12 Juin 2020

Bonjour
Le code si dessous me donne :
10 20 30 40
alors que je voudrais les index 2,4,6,8 de array value
merci
code:
Option Base 1

Sub Index_to_Value()

Dim Array_Index()
Dim Array_Value()
Dim Array_Destination()

Array_Index = Array(2, 4, 6, 8)
Array_Value = Array(10, 20, 30, 40, 50, 60, 70, 80, 90, 100)
ReDim Array_Destination(UBound(Array_Index))

For i = LBound(Array_Index) To UBound(Array_Index)
Array_Destination(i) = Array_Value(i)
Next
[C10].Resize(, UBound(Array_Destination)) = Array_Destination

End Sub

code:
Option Base 1

Sub Index_to_Value()

Dim Array_Index()
Dim Array_Value()
Dim Array_Destination()

Array_Index = Array(2, 4, 6, 8)
Array_Value = Array(10, 20, 30, 40, 50, 60, 70, 80, 90, 100)
ReDim Array_Destination(UBound(Array_Index))

For i = LBound(Array_Index) To UBound(Array_Index)
Array_Destination(i) = Array_Value(i)
Next

[C10].Resize(, UBound(Array_Destination)) = Array_Destination

End Sub

Hasco · 13 Juin 2020

Bonjour,

VB:

Sub Index_to_Value()

    Dim Array_Index()
    Dim Array_Value()
    Dim Array_Destination()
    Dim i As Integer
   
    Array_Index = Array(2, 4, 6, 8)
    Array_Value = Array(10, 20, 30, 40, 50, 60, 70, 80, 90, 100)
    ReDim Array_Destination(UBound(Array_Index))

    For i = LBound(Array_Index) To UBound(Array_Index)
        ' Récupérer la valeur correspondant à Array_index(i)
        Array_Destination(i) = Array_Value(Array_Index(i))
    Next
    '
    ' En base 0 rajouter 1 à ubound (Les tableaux de cellules sont en base 1)
    [C10].Resize(, UBound(Array_Destination) + 1) = Array_Destination


End Sub

Cordialement

Hoareau · 13 Juin 2020

je vous remercie quadruplement
-j'ai eu une réponse
-j'ai eu une réponse rapide à laquelle, je n'ai pu répondre rapidement
- j'ai une une réponse qui correspond à ce que je voulais
-et des explications

Mis à part cela, ce bout de code, fera parti, si je réussi, d'une fonction perso Top n valeur
(Plage d'entrée range,Top n )
sortie en deux tableaux Top n valeur Valeur,rang(Index)' (rank ne passant pas sur les tabeaux)

Roblochon à dit:

Bonjour,

VB:

Sub Index_to_Value()

    Dim Array_Index()
    Dim Array_Value()
    Dim Array_Destination()
    Dim i As Integer
 
    Array_Index = Array(2, 4, 6, 8)
    Array_Value = Array(10, 20, 30, 40, 50, 60, 70, 80, 90, 100)
    ReDim Array_Destination(UBound(Array_Index))

    For i = LBound(Array_Index) To UBound(Array_Index)
        ' Récupérer la valeur correspondant à Array_index(i)
        Array_Destination(i) = Array_Value(Array_Index(i))
    Next
    '
    ' En base 0 rajouter 1 à ubound (Les tableaux de cellules sont en base 1)
    [C10].Resize(, UBound(Array_Destination) + 1) = Array_Destination


End Sub

Cordialement

Hoareau · 14 Juin 2020

Bonjour
Un problème que j'avais oublié , les N° différents avec les mêmes index
ex :
Array_Index = Array(1, 1, 1, 8)
me renvoi :

10

80

Alors que le résultat est :
10, 20, 30, 80

merci

Hoareau à dit:
je vous remercie quadruplement
-j'ai eu une réponse
-j'ai eu une réponse rapide à laquelle, je n'ai pu répondre rapidement
- j'ai une une réponse qui correspond à ce que je voulais
-et des explications

Mis à part cela, ce bout de code, fera parti, si je réussi, d'une fonction perso Top n valeur
(Plage d'entrée range,Top n )
sortie en deux tableaux Top n valeur Valeur,rang(Index)' (rank ne passant pas sur les tabeaux)

Hasco · 14 Juin 2020

Bonjour,

Là, c'est comme si vous vouliez que 1+1 fasse 3 !!!!!

Cordialement

Hoareau · 14 Juin 2020

Pas exactement, mais je me disais que peut être, il y avait un moyen, de contourner
en disant par exemple que si a déjà été affecté prendre le second etc...
Plus facile à dire qu'à faire

Hasco · 14 Juin 2020

Re,

C'est comme ça qu'on crée de bonnes usines à gaz.
Créez plutôt deux fonctions avec deux noms différents !

Cordialement

Hoareau · 14 Juin 2020

l'une et l'autre ferait quoi

Roblochon à dit:
Re,

C'est comme ça qu'on crée de bonnes usines à gaz.
Créez plutôt deux fonctions avec deux noms différents !

Cordialement

Hasco · 14 Juin 2020

Bonjour,

Ce que vous demandiez dans le post #4.

Cordialement

patricktoulon · 14 Juin 2020

Bonjour @Roblochon @Hoareau

juste comme ça en passant
on peut très bien récupérer les éléments distincts d'un array sans boucle

demo

VB:

Sub test()

    Dim Array_Index, Array_Value, Array_Destination

    Array_Index = Array(2, 4, 6, 8)

    Array_Value = Array(10, 20, 30, 40, 50, 60, 70, 80, 90, 100)

    'Array_Destination = Application.Index(Array_Value, Evaluate("Row(1:1)"), Array_Index)
    
    'ou sans evaluate
    
    Array_Destination = Application.Index(Array_Value, 0, Array_Index)


   MsgBox "le LBOUND de Array_Destination est " & LBound(Array_Destination) & vbCrLf & Join(Array_Destination, "-")
End Sub

j'attire votre attention sur le fait que d'utiliser app.index ou même evaluate fait que vba va travailler automatiquement en base 1

la seule différence entre les deux méthodes c'est que l'index de ligne ( 0 ou Evaluate("Row(1:1)")) est en base réelle sans evaluate soit 0

mapomme · 14 Juin 2020

Bonjour @Hoareau , @Roblochon ; @patricktoulon

Une tentative pour votre deuxième demande.
Les hypothèses:

Option Base peut-être à 0 ou 1
Dans le tableau index, les index commencent à 1 (à priori d'après ce que j'ai compris) : 1 correspond au premier élément des valeurs.
Dans le tableau des index, les index ne sont pas forcément triés en ordre croissant
Le premier index 1 rencontré, renvoie la première valeur du tableau des valeurs
Les 1 suivants renvoient la valeur d'index de l'élément précédent augmenté de 1

Ce qui donne par exemple :

Le code :

VB:

Sub N_Index()
Dim Array_Index, Array_Value, i As Long, decal&, oldIndex&, newindex&, dejaUn As Boolean
   Array_Index = Array(2, 4, 6, 8)           '  (2,4,6,8)  (1,1,1,8) (2,1,1,8) (2,1,1,5,8,1,3)

   Array_Value = Array(10, 20, 30, 40, 50, 60, 70, 80, 90, 100)
   ReDim Array_Destination(UBound(Array_Index))

   If LBound(Array_Index) = 0 Then decal = -1 Else decal = 0
   newindex = Array_Index(LBound(Array_Index))
   Array_Destination(LBound(Array_Index)) = Array_Value(newindex + decal)
   oldIndex = newindex: dejaUn = oldIndex = 1

   For i = LBound(Array_Index) + 1 To UBound(Array_Index)
      If Array_Index(i) = 1 Then
         If dejaUn Then
            newindex = oldIndex + 1
         Else
            newindex = 1
            dejaUn = True
         End If
      Else
         newindex = Array_Index(i)
      End If
      Array_Destination(i) = Array_Value(newindex + decal)
      oldIndex = newindex
   Next i
   Range(Range("c10"), Cells(10, Columns.Count).End(xlToLeft)).ClearContents
   [C10].Resize(, UBound(Array_Destination) - LBound(Array_Destination) + 1) = Array_Destination
End Sub

Hoareau · 14 Juin 2020

Impeccable, les deux solutions fonctionnent bien, mais dans la 1ère solution, la sortie ayant changée, je ne sais pas comment récupérer, les valeurs pour les mettre dans un tableau

mapomme · 14 Juin 2020

Re,

Une généralisation : L'index 1 ne joue un rôle particulier; Tous les index suivent la même règle:

Quand on rencontre pour la première fois un index, on retourne la valeur correspondant à cet index.
Quand on on rencontre un index pour la seconde fois (ou plus), alors on retourne la valeur correspondant à l'index de la valeur précédente +1

Ce qui donne (voir le dernier cas) :

Le code :

VB:

Sub N_Index()
Dim Array_Index, Array_Value, i As Long, decal&, oldIndex&, newindex&, dejaUn As Boolean
   Array_Index = Array(2, 4, 4, 4, 3, 3, 1, 8)        '(2, 4, 6, 8) (1, 1, 1, 8) (2, 1, 1, 8) (2, 1, 1, 5, 8, 1, 3) (2, 4, 4, 4, 3, 3, 1, 8)
   Array_Value = Array(10, 20, 30, 40, 50, 60, 70, 80, 90, 100)
   ReDim Array_Destination(UBound(Array_Index))
   ReDim dejaVu(LBound(Array_Value) To UBound(Array_Value))

   If LBound(Array_Index) = 0 Then decal = -1 Else decal = 0
   newindex = Array_Index(LBound(Array_Index))
   Array_Destination(LBound(Array_Index)) = Array_Value(newindex + decal)
   oldIndex = newindex
   dejaVu(newindex) = True

   For i = LBound(Array_Index) + 1 To UBound(Array_Index)
      If dejaVu(Array_Index(i)) Then
         newindex = oldIndex + 1
      Else
         newindex = Array_Index(i)
         dejaVu(Array_Index(i)) = True
      End If
      Array_Destination(i) = Array_Value(newindex + decal)
      oldIndex = newindex
   Next i
   Range(Range("c10"), Cells(10, Columns.Count).End(xlToLeft)).ClearContents
   [C10].Resize(, UBound(Array_Destination) - LBound(Array_Destination) + 1) = Array_Destination
End Sub

patricktoulon · 14 Juin 2020

re
je pige pas très bien l’intérêt de tout ça mais soit

VB:

Sub testX()
    Dim Array_Index, Array_Value

    Array_Value = Array(10, 20, 30, 40, 50, 60, 70, 80, 90, 100)

    GetarrayValue Array(2, 4, 6, 8), Array_Value                ' test1
    GetarrayValue Array(1, 1, 1, 8), Array_Value                ' test2
    GetarrayValue Array(2, 1, 1, 8), Array_Value                ' test3
    GetarrayValue Array(2, 1, 1, 5, 8, 1, 3), Array_Value       ' test4
    GetarrayValue Array(2, 4, 4, 4, 3, 3, 1, 8), Array_Value    ' test5

End Sub

Sub GetarrayValue(Array_Index, Array_Value)
    Dim Array_Destination, Array_Indexbis
    ReDim Array_Indexbis(UBound(Array_Index)): Array_Indexbis(0) = Array_Index(0)
    For i = 1 To UBound(Array_Index)
        Array_Indexbis(i) = IIf(Array_Index(i) = Array_Index(i - 1), Array_Indexbis(i - 1) + 1, Array_Index(i))
    Next
    Array_Destination = Application.Index(Array_Value, 0, Array_Indexbis)
    With Cells(Rows.Count, 1).End(xlUp).Offset(1)
        .Value = "(" & Join(Array_Index, ",") & ")"
        .Offset(, 1).Resize(1, UBound(Array_Indexbis) + 1) = Array_Destination
    End With
End Sub

mapomme · 14 Juin 2020

QUOTE="patricktoulon, post: 20340662, member: 167882"]
je pige pas très bien l’intérêt de tout ça mais soit
[/QUOTE]
Moi non plus.
C'est pas tout fait équivalent à ce que j'ai fait mais je préfère ton interprétation (qui est d'ailleurs beaucoup plus simple). Comme on ne connaît pas la finalité...

XL 2019 Tableau index vers valeur

Hoareau

XLDnaute Occasionnel

Hasco

XLDnaute Barbatruc

Hoareau

XLDnaute Occasionnel

Hoareau

XLDnaute Occasionnel

Hasco

XLDnaute Barbatruc

Hoareau

XLDnaute Occasionnel

Hasco

XLDnaute Barbatruc

Hoareau

XLDnaute Occasionnel

Hasco

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Hoareau

XLDnaute Occasionnel

mapomme

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Discussions similaires