Microsoft 365 Rotation circulaire d'un array

[klin89]

Bonjour à tous,

J'aimerais à l'aide d'une des 3 méthodes proposées dans ce lien, effectuer une rotation circulaire et retourner un nouvel array via une fonction.
Rotation circulaire array
Exemple, je cherche 3 dans arr et j'aimerais retourner [3, 4, 5, 6, 7, 1, 2]

Dim arr, pos As Byte
arr = Array(1, 2, 3, 4, 5, 6, 7)
pos = Application.Match(3, arr, 0)

Pouvez-vous m'aider à traduire l'un de ces codes en VBA.
Merci d'avance
klin89

 

[Dranreb]

Bonsoir.
Comme ça ? :

Function TbCycl(ByVal Déb As Integer, ByVal Nb As Integer) As Integer()
   Dim TbC() As Integer, P As Integer
   ReDim TbC(1 To Nb)
   For P = 1 To UBound(TbC)
      TbC(P) = Déb
      Déb = Déb Mod UBound(TbC) + 1
      Next P
   TbCycl = TbC
   End Function
Sub Test()
   Dim TbC() As Integer, TMsgBox() As String, N
   TbC = TbCycl(3, 7)
   ReDim TMsgBox(1 To UBound(TbC))
   For N = 1 To UBound(TbC)
      TMsgBox(N) = TbC(N): Next N
   MsgBox "[" & Join(TMsgBox, ", ") & "]"
   End Sub

 

[Franc58]

Salut, voici la fonction:

Function RotateArray(arr() As Variant, d As Integer) As Variant
    Dim N As Integer
    N = UBound(arr) - LBound(arr) + 1
    d = d Mod N
    Dim rotatedArr() As Variant
    ReDim rotatedArr(LBound(arr) To UBound(arr))
    Dim i As Integer
    For i = LBound(arr) To UBound(arr)
        rotatedArr((i - d + N) Mod N) = arr(i)
    Next i
    RotateArray = rotatedArr
End Function

Et une petite macro test pour vérifier la tableau avant et après application de la fonction:

Sub test()
    Dim MyArray() As Variant
    Dim Valeur As Variant
    MyArray = Array(1, 2, 3, 4, 5, 6, 7)
    For Each Valeur In MyArray
        Debug.Print Valeur
    Next Valeur
    MyArray = RotateArray(MyArray, 3)
    For Each Valeur In MyArray
        Debug.Print Valeur
    Next Valeur
End Sub

Oups! Je m'aperçois qu'à quelques secondes près, j'ai répondu en même temps que Dranreb

 

[mapomme]

Bonjour à tous ,

Je viens un peu tard. J'ai donc fourni une option supplémentaire :

• si le décalage est négatif, on décale vers la gauche
• si le décalage est positif, on décale vers la droite

Cliquer sur le bouton Hop!

code de la fonction :

Function shiftN(Arr, ByVal n As Integer)
Dim j&, k&, q&
   ReDim r(LBound(Arr) To UBound(Arr)): n = -n: q = (UBound(Arr) - LBound(Arr) + 1): n = n Mod q
   For j = LBound(Arr) To UBound(Arr): k = IIf(n >= 0, (j + n) Mod q, (q + j + n) Mod q): r(j) = Arr(k): Next j
   shiftN = r
End Function

nota : mon code est analogue à celui de @Franc58 (que je n'avais pas lu )
..

 

[klin89]

Bonjour à tous,

Merci à tous pour vos réponses.
Le code de bernard correspond le mieux à ma demande, je choisis un élément parmi une variable tableau à une dimension et me base sur la position de celui-ci pour effectuer la rotation.
J'aimerais donc que la fonction appelle un array à une dimension.
Par contre, j'aurais dû préciser que je pouvais travailler avec un array composé de string comme ci-dessous.
Avec le code de mapomme et Franc58, je rentre un décalage, désolé pour le manque de précision.

Je cherche 3 :

input = Array(1, 2, 3, 4, 5)
output = Array(3, 4, 5, 1, 2)

input = Array(4, 2, 3, 5, 1)
output = Array(3, 5, 1, 4, 2)

je cherche d :

input = Array("a", "b", "c", "d", "e")
output = Array("d", "e", "a", "b", "c")

klin89

 

[sylvanu]

Bonsoir Klin, Dranreb, Frank, Mapomme,
Peut être avec :

Function Rotation(Tablo, Début)
    Dim Pos%, i%, Taille%, T
    Pos = Application.Match(Début, Tablo, 0) - 1
    Taille = UBound(Tablo)
    ReDim T(Taille)
    For i = 0 To Taille
        If Pos > Taille Then Pos = 0
        T(i) = Tablo(Pos)
        Pos = Pos + 1
    Next i
    Rotation = T
End Function

Avec "Resultat = Rotation(arr, 3)" et "Resultat = Rotation(arr, "c")" cela donne ça :

 

[patricktoulon]

@sylvanu
j'ai fait quelque chose de simailaire mais ca ne fonctionne qu'en base 0
tiens du coup j'ai modifié le truc ca fait les deux maintenant

Sub Test_BASE_0()
Dim arr, Resultat
arr = Array("a", "b", "c", "d", "e", "f", "g")
Resultat = Rotation(arr, "c")
[A2].Resize(1 + UBound(arr), 1) = Application.Transpose(arr)
[B2].Resize(1 + UBound(Resultat), 1) = Application.Transpose(Resultat)
End Sub

Sub Test_BASE_1()
Dim arr, Resultat
arr = Application.Transpose([A2:A8].Value)
Resultat = Rotation(arr, "c")
[B2].Resize(UBound(Resultat), 1) = Application.Transpose(Resultat)
End Sub

Function Rotation(Tablo, Début)
    Dim Pos%, i%, Taille%
    Pos = Application.Match(Début, Tablo, 0) - Abs(LBound(Tablo) = 0)
    Taille = UBound(Tablo)
    ReDim T(LBound(Tablo) To Taille)
    For i = LBound(Tablo) To Taille
        If Pos > Taille Then Pos = LBound(Tablo)
        T(i) = Tablo(Pos)
        Pos = Pos + 1
    Next i
    Rotation = T
End Function

 

[klin89]

Re à tous,

Avec le titre du post et le lien proposé, j'ai induit mapomme et Franc58 en erreur.
J'aurais dû intituler le post "Rotation d'éléments d'un array"
sylvanu, c'est exactement ce que je cherchais à réaliser.

Merci à toi et à tous les intervenants.

 

[patricktoulon]

re
prend le mien @klin89 il encaisse le base 0 et 1
si ru dois t'en resservir autant ne faire qu'une seule fonction

 

[klin89]

Re patrick

Je peux convertir arr en base 1 comme ceci non ?

Base 0

arr = Array("a", "b", "c", "d", "e", "f", "g")

Puis conversion en Base 1

arr = Application.Transpose(Application.Transpose(arr))

Ou alors je n'ai pas compris ce que tu voulais me dire.
klin89

 

[mapomme]

Re,

On peut aussi utiliser (et il y en a sans doute encore d'autres) :
ReDim Preserve arr(1 To UBound(arr) - LBound(arr) + 1) reste dans VBA
ou arr = Application.Index(arr, 0, 0) passe par Excel

 

[sylvanu]

Re,
Ou encore rester en base0 si l'origine de l'array est bien en VBA comme dans l'ex donné en post #1.
Le passage en base1 n'est utile que si l'origine de l'array est indifféremment une déclaration en VBA ou une plage de cellules.

 

[patricktoulon]

re
oui c'est bien ce que j'ai dit
je n'ai jamais dit qu'il fallait changer la base
ma version est faite juste au cas ou le variant serait en base 1 mais il marche aussi en base 0 sans rien changer
autrement dit en plus court je fait les deux en une
dans mon exemple je le montre bien
le 2d le tableau est pris dans un range donc en 2 dim et en base 1