Création d'un tableau de 1: N dans VBA

C'est une question super simple et je n'ai pas encore été en mesure de rassembler une solution que je veux des réponses précédentes.

J'ai N images sur une feuille et je souhaite simplement les regrouper. Normalement, j'utiliserais:

Sheets("Mail").Shapes.Range(Array(1,2,3,4,5)).Group

mais évidemment cela ne fonctionne pas si je veux passer de 1 à N. J'essaie actuellement:

 For i = 0 To Y / 33 ReDim Preserve test(i) test(i) = i Next i Sheets("Mail").Shapes.Range(Array(test())).Group 

Mais je ne sais pas comment utiliser mon object de test pour reproduire le format que j'ai utilisé dans le cas non général. Toute aide appréciée!

C'est une fonction, renvoyant des arrays numériques de M à N :

 Public Function ReturnArrayAtoB(ByVal M As Long, ByVal N As Long) As Variant Dim lngCounter As Long Dim arrReturn As Variant ReDim arrReturn(N - M) For lngCounter = 0 To N - M arrReturn(lngCounter) = M + lngCounter Next lngCounter ReturnArrayAtoB = arrReturn End Function 

Voici comment vous l'appelez:

 arrA = ReturnArrayAtoB(1, 5) arrB = ReturnArrayAtoB(10, 12) 

Le premier renvoie Array(1,2,3,4,5) et le second renvoie Array(10,11,12)

Pour plus de détails, il existe une façon plus concise de créer des arrays contigus à l'aide de la fonction Evaluate :

 Public Function ReturnArrayWithEvaluate(ByVal M As Long, ByVal N As Long) As Variant Dim vArr1 As Variant vArr1 = Application.Transpose(Evaluate("ROW(" & M & ":" & N & ")")) ReturnArrayWithEvaluate = vArr1 End Function 

Comme Vityata l'observe dans les commentaires, cette méthode comporte des lacunes:

  • Il échoue si N > ActiveSheet.Rows.Count
  • Il a une portabilité limitée, car ROWS n'existe pas dans d'autres versions VBA, telles que Access VBA
  • En ce qui concerne la performance, cela ne vaut pas la peine

Je signale par la présente certains tests, dans lesquels je modifie la valeur de N de 10,000 à 1,000,0000 10,000 1,000,0000 et exécute les deux methods (pour M=1 ).

Configuration de reference

Fonctions utilisées:

 Private Declare Function GetTickCount Lib "kernel32.dll" () As Long Public Function ReturnArrayWithEvaluate(ByVal M As Long, ByVal N As Long) As Variant Dim vArr1 As Variant vArr1 = Application.Transpose(ActiveSheet.Evaluate("ROW(" & M & ":" & N & ")")) ReturnArrayWithEvaluate = vArr1 End Function Public Function ReturnArrayAtoB(ByVal M As Long, ByVal N As Long) As Variant Dim lngCounter As Long Dim arrReturn As Variant ReDim arrReturn(N - M) For lngCounter = 0 To N - M arrReturn(lngCounter) = M + lngCounter Next lngCounter ReturnArrayAtoB = arrReturn End Function Sub test() Dim M As Long, N As Long Dim lTicks As Long Dim lCnt As Long, lStep As Long, lCnt2 As Long Dim vArrReturn As Variant Dim vArrResults As Variant M = 1 N = 10000 lStep = 9900 / 2 lCnt2 = 1 ReDim vArrResults(1 To 99 * N / lStep + 1) For lCnt = N To N * 100 Step lStep lTicks = GetTickCount vArrReturn = ReturnArrayAtoB(M, lCnt) vArrResults(lCnt2) = GetTickCount - lTicks lCnt2 = lCnt2 + 1 Next lCnt Range("B2").Resize(lCnt2 - 1, 1).Value2 = Application.Transpose(vArrResults) lCnt2 = 1 For lCnt = N To N * 100 Step lStep lTicks = GetTickCount vArrReturn = ReturnArrayWithEvaluate(M, lCnt) vArrResults(lCnt2) = GetTickCount - lTicks lCnt2 = lCnt2 + 1 Next lCnt Range("C2").Resize(lCnt2 - 1, 1).Value2 = Application.Transpose(vArrResults) End Sub 

Résultats

L'axe horizontal montre N et l'axe vertical le time utilisé par chaque méthode.

Looping vs Evaluate Ticks, pour différents <code> N </ code>

Pour les grands arrays, l'évaluation est plus rapide que la mise en boucle.

L'affirmation selon laquelle Evaluate est plus rapide que la boucle est en fait incorrecte!

En moyenne, les deux methods consumnt à peu près au même moment:

 -- Average Looping is 57 ticks -- Average Evaluate is 62 ticks -- Median ticks are 62 for both methods 

Dans l'set, je pense que le fait de boucler est probablement une meilleure option.