Cas d'usage
Dans mes activités de PMO (personne n'est parfait) je m'amuse (!) à construire de jolies feuilles de route, ou roadmap pour les intimes du barratin globish. Les meilleurs amis du PMO pour ce type d'activité sont Excel et powerpoint :- Excel pour la collecte de données (je suis un IT guy quand même),
- Powerpoint pour la couche de présentation un peu "glam'".
Bon, pour finir l'explication, j'ai donc une très belle feuille de route, avec beaucoup de jalons, sous format excel, un nombre de clients et de domaines applicatifs importants, et un besoin de présenter des visions différenciées à chacun.
Pour cela, rien ne vaut Excel (toujours), beaucoup de mise en forme conditionnelle et quelques macros.
Le problème
Le principe est de récupérer (à la main) une copie de la feuille de route pour la mettre dans un onglet complémentaire, puis de nettoyer les cases sans contenu visible pour que l'affichage soit un peu sympa.Je partage ce petit bout de code avec vous, qui est la version 0.
Sub makeItClear()
Dim ws As Worksheet, r As Range, c As Range, nbligne As Long
Application.ScreenUpdating = False
Set ws = ThisWorkbook.Sheets("Feuil1")
nbligne = InputBox("nb ligne à traiter", , 20) + 0
Set r = ws.Range("d8:aa" & nbligne)
For Each c In r.Cells
If c.Text = "" Then c.ClearContents
If Len(c.Text) > 2 Then c.HorizontalAlignment = xlLeft
Next
Application.ScreenUpdating = True
End Sub
De manière très simple, l'algorithme marche, par contre, c'est long. Pour une plage d'une quarantaine de lignes, il faut compter entre quinze et vingt minutes. Pour la feuille de route complète, pas loin d'une heure.
Le pourquoi
Après beaucoup de recherche, il s'avère que la partie lourde de l'algorithme est la partie écriture/réécriture du classeur, c'est à dire :
If c.Text = "" Then c.ClearContents
Le problème vient du coût d'accès systématique au classeur pour écrire. Rien de nouveau me direz vous, et vous avez parfaitement raison. Le coût d'accès en écriture est toujours ce qui coûte cher en I/O et casse les performance.
Un peu de craft
Le problème étant l'accès, la première idée qui me vient est donc de ne plus faire un accès simultanée mais un accès par "small batch".
Sub makeItClear()
Dim myCells As String
Dim ws As Worksheet, r As Range, c As Range, nbligne As Long
myCells = "$E$5" 'cellule d'init ou il n'y a rien
Application.ScreenUpdating = False
Set ws = ThisWorkbook.Sheets("Feuil1")
nbligne = InputBox("nb ligne à traiter", , 20) + 0
Set r = ws.Range("f8:ag" & nbligne)
For Each c In r.Cells
If c = "" Then myCells = myCells + "," + c.Address
If Len(c.Text) = 1 Then c.HorizontalAlignment = xlCenter
Next
ws.range(mycells).clearcontents
Application.ScreenUpdating = True
End Sub
Pour faire simple, au lieu de faire un accès immédiat, le principe est de stocker la liste de tous les cas positifs et de faire une suppression globale.
L'idée est belle, mais ça ne marche pas du premier coup ! Sur le fond, le soucis est que la plage est trop longue !
Plus de craft !
Alors un peu de tests, il semble que la limite du 'range' de VBA est de 256 caractères. Pourquoi ? Je ne sais pas, dans tous les cas, une chaine de 256 caractères passe le test, une chaine de 512 non.Pour s'en sortir, il reste donc à éclater la chaine en sous-chaine de maximum 256 caractères. Dans tous les autres langages, j'aurais joué avec des tableaux. En VBA, c'est vraiment pas pratique. Il reste donc à jouer avec des chaines :-/
On va donc faire une modification dans le code et rajouter deux fonctions complémentaires :
Sub makeItClear()
Dim myCells As String, calculMode As Variant
...
myCells = Replace(myCells, "$", "")
While Len(myCells) > 0
m = cutLongList(myCells, ",", 256)
ws.Range(m).Value = ""
myCells = Mid(myCells, Len(m) + 2)
Wend
Application.ScreenUpdating = True
End Sub
Je nettoie donc la chaine de plage des '$' pour réduire sa taille, puis je travaille une boucle de réduction de chaine.
Pour cela, il faut deux petites fonctions :
Private Function cutLongList(ByVal myString As String, ByVal delimiter As String, ByVal maxValue As Long) As String
Dim i As Long
cutLongList = myString
If Len(myString) < maxValue Then Exit Function i = 0 While isMyNumCarMyCar(myString, maxValue - i, delimiter) = False i = i + 1Wend cutLongList = Mid(myString, 1, maxValue - i - 1)End Function Function isMyNumCarMyCar(ByVal myString As String, ByVal numCar As Long, ByVal myCar As String) As Boolean '''Pour vérifier qu'un numéro de caractères correspond à un caractère attendu isMyNumCarMyCar = IIf(Mid(myString, numCar, 1) = myCar, True, False) End Function
N'ayant pas de meilleures fonctionnalités pour faire du slicing de chaines avec des Arrays, la fonction 'isMyNumCarMyCar' permet de vérifier qu'un numéro de caractère de chaine est bien un caractère passé en paramètre.
Et 'cutLongList' permet juste de faire le retour de substring. Elle serait sans doute à améliorer avec quelques traitements d'erreurs.
Conclusion
Première conclusion, ce changement de code permet de passer d'un temps de traitement de 10 minutes à moins de 30 secondes. Evidemment, ça jette.Au milieu, je retiens :
- Que l'accès en écriture dans les classeurs excel est à limiter dans les boucles,
- Que l'objet range de VBA contient au maximum 256 caractères,
- Que les objets Arrays de VBA sont vraiment pas top en termes de capacité.
