Développement VBA – Exemple automatisation
Cet exemple montre des
Cette automatisation pourrait être réalisée avec une requête
L'utilisation du module OLAP
Pour le volume de données, il y a 2 versions, une version de 1,000 lignes (1K) et une version de 10,000 lignes (10K). Les scripts de cet exemple présentent les mêmes résultats mais ont un fonctionnement différent.
Les données doivent être retraitées sur plusieurs lignes avec les informations des autres champs.
![La boite de dialogue de l'enregistreur de macro](130a_img_tg/p01_tabgrap_120_0020a_img01.png)
Exemple du retraitement
![La boite de dialogue de l'enregistreur de macro](130a_img_tg/p01_tabgrap_120_0020a_img02ggg.png)
Pour un volume de données de 1K, le script vba peut fonctionner de bas en haut en ajoutant autant des lignes pour chaque tuple (données d'une ligne) à créer.
Le script ci-dessus fonctionne sur un volume de données moindre que le scripts ci-dessous du fait l'ajout du ligne par la méthode insert sur la feuille de calcul ralentit le temps de traitement... La
Public Const COL_M = 5 'champs machine
Private Sub DonneesETL_v1_0()
'Routine qui sépare les données de la colonne "Machine" en colonne E
'sur des lignes distinctes avec les informations identiques à celles
'd'origine
'
Dim feuilSrc As Worksheet, feuilDest As Worksheet
Dim derLig As Long, derCol As Long, cnt As Long
Dim tVar() As String
'selection de l'onglet des données
With ThisWorkbook
Set feuilSrc = .Worksheets("DONNEES_BRUTES_1K")
Set feuilDest = .Worksheets("donneesMAJ_1K")
End With
'on copie les données source dans l'onglet donneesMAJ_1K ou _10K
'pour ne pas modifier directement les données sources
feuilSrc.Cells.Copy feuilDest.Cells
With feuilDest
.Activate
'dernière ligne de la région de données
derLig = .Cells(.Rows.Count, COL_M).End(xlUp).Row
'pour la boucle do
lig = derLig: cnt = 0
'on part de la dernière ligne
Do
'on affecte les valeurs de la colonne 5 (COL_M) avec le séparateur ";"
'dans le tableau tVar()
tVar() = Split(CStr(.Cells(lig, COL_M)), ";")
'dimension du tableau tVar()
cnt = UBound(tVar, 1)
' il y a 2 valeurs séparé par 1 ";"
If cnt = 1 Then
'on efface les valeurs concernées
'elles sont déjà en mémoire dans le tableau tVar()
.Cells(lig, COL_M).ClearContents
'on selectionne la ligne, on copie et on insert 1 ligne
Set r = .Cells(lig, COL_M).EntireRow
r.Copy
r.Insert shift:=xlDown: Application.CutCopyMode = False
lig = lig - cnt
Set r = .Cells(lig + 1, COL_M)
'on transpose les valeurs du tableaux tVar dans les 2 cellules
'de la ligne insérée et de la ligne existante
r.Resize(UBound(tVar) + 1).Value = Application.Transpose(tVar)
'il y a 2 ou + de valeurs séparées par ";"
ElseIf cnt > 1 Then
'on efface les valeurs concernées
'elles sont déjà en mémoire dans le tableau tVar()
.Cells(lig, COL_M).ClearContents
'la dimension de tVar est sur une base 0
'la feuille de calcul est sur une base 1
'donc on diminue l'indice de 1 sur la variable cnt
cnt = cnt - 1
'on copie les données de la ligne à recopier dans l'objet r
Set r = .Cells(lig, COL_M).EntireRow
r.Copy
'on insère autant de lignes que d'indices dans le tableau tVar()
.Range(.Cells(lig, COL_M), .Cells(lig + cnt, _
COL_M)).EntireRow.Insert shift:=xlDown
Application.CutCopyMode = False
'on transpose le tableau des valeurs Machine
'dans les cellules de lignes insérées
Set r = .Cells(lig, COL_M)
r.Resize(UBound(tVar) + 1).Value = Application.Transpose(tVar)
'on repositionne le curseur
lig = lig - 1
Else
'il n'y a qu'1 seule valeur, on ne fait rien
'on décrémente lig pour remonter la boucle do vers le haut
lig = lig - 1
End If
Loop Until lig = 1 'on boucle jusqu'à ligne des titres
derLig = .Cells(.Rows.Count, COL_M).End(xlUp).Row
Set rng = .Range(.Cells(2, COL_M), .Cells(derLig, COL_M))
'on enlève les espaces supplémentaires
For Each c In rng
c.Value = LTrim(c.Value)
Next c
End With
With ThisWorkbook
Set feuilSrc = Nothing
Set feuilDest = Nothing
End With
End Sub
Sur une machine virtuelle avec
Le script ci-dessous copie les données dans un objet range et le traitement se fait sur cet objet. Ce script est de
Script 2
Public Const COL_M = 5 'champs machine
Private Sub DonneesETL_v2()
'Routine qui sépare les données de la colonne "utilisateur" en colonne E
'sur des enregistrements distincts et copie les donnees dans l'onglet
'donneesMAJ
Dim feuilSrc As Worksheet
Dim feuilDest As Worksheet
Dim rng As Range, c As Range
Dim derLig As Long, derCol As Long, cnt As Long, nb_sep As Long
Dim LigTotal As Long
With ThisWorkbook
Set feuilSrc = .Worksheets("DONNEES_BRUTES_10K")
Set feuilDest = .Worksheets("donneesMAJ_10K")
End With
'on efface les données de la feuille qui contient les
'résultats pour éviter toute confusion
feuilDest.Cells.ClearContents
With feuilSrc
.Activate
'dernière ligne des données non MAJ
derLig = [A1].End(xlDown).Row
'dernière colonne
derCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
'on copie les données de la colonne E dans l'objet rng
Set rng = .Range(.Cells(2, COL_M), .Cells(derLig, COL_M))
'on initialise les variables
cnt = 0: nb_sep = 0
'on compte le nombre de ";" pour affecter la dimension
'nb_sep au tableau dans l'étape suivante
For Each c In rng
arr = Split(CStr(c.Value), ";")
cnt = UBound(arr, 1)
nb_sep = nb_sep + cnt
Next c
'le tableau en mémoire est base 0
'on diminue la dimension de la ligne de titre
nb_sep = nb_sep + derLig - 2
'vTab_1() est un tableau en mémoire initialisé
'de 2 dimensions ligne / colonne
ReDim vTab_1(nb_sep, derCol - 1) As String
'initialise les variables
cnt = 0: m = 0
For Each c In rng
'on boucle sur la colonne E des données
'qui sont copiées dans l'objet rng
'on copie les valeurs dans un tableau arr()
arr = Split(CStr(c.Value), ";")
'on compte le nombre de valeur dans la colonne E
'pour l'itération correspondante
cnt = UBound(arr, 1)
's'il y a 2 valeurs ou +
If cnt > 0 Then
For k = LBound(arr, 1) To UBound(arr, 1)
'on boucle sur les valeurs du tableau arr()
For i = LBound(vTab_1, 2) To UBound(vTab_1, 2)
'on copie dans vTab_1 des données du tuple concerné
'qui contiennent plusieurs valeurs
If i + 1 = c.Column Then
'la colonne suivante est celle qui doit contenir
'les valeurs séparées
vTab_1(m, i) = LTrim(arr(k))
Else
'on copie simplement les autres données du tuple
vTab_1(m, i) = .Cells(c.Row, i + 1)
End If
Next i
'on incremente vTab() d'autant de tuple à insérer
m = m + 1
Next k 'valeur suivante
Else
'il n'y a qu'une seule valeur
'on copie simplement le tuple dans le tableau vTab()
For i = LBound(vTab_1, 2) To UBound(vTab_1, 2)
vTab_1(m, i) = .Cells(c.Row, i + 1)
Next i
'on incrémente vTab()
m = m + 1
End If
Next c
'on copie l'objet rng dans la feuille de calcul
'cet objet ne contient les valeurs machine
'les valeurs machine sont dans le tableau en mémoire
Set rng = .Range(.Cells(1, 1), .Cells(1, derCol))
rng.Copy feuilDest.Range("A1")
End With 'feuilSrc
With feuilDest
'<----->
.Activate
'on copie les valeurs machine dans la colonne / le champs correspondant
'des données qui étaient dans l'objet rng
.Range(.Cells(2, 1), .Cells(UBound(vTab_1, 1), derCol)) = vTab_1
'on réajuste la taille des colonnes
For i = 1 To 8
Columns(i).ColumnWidth = feuilSrc.Columns(i).ColumnWidth
Next i
Columns(COL_M).ColumnWidth = 25
'<----->
End With 'feuilDest
Set rng = Nothing
With ThisWorkbook
Set feuilSrc = Nothing
Set feuilDest = Nothing
End With
'MsgBox "Fin traitement", vbInformation
End Sub
Pour le script ci-dessus, la durée de traitement est de moins d'1 seconde pour 10K lignes sur la machine virtuelle. Le taux d'utilisation du processeur est d'approximativement 30% sur cette durée.
Ce script peut être équivalent à l'emploi des objets
Le script suivant fait tout le retraitement en mémoire.
Script 3
Public Const COL_M = 5 'champs machine
Private Sub DonneesETL_v3()
'Routine qui sépare les données de la colonne "utilisateur" en colonne E
'sur des enregistrements distincts et copie les donnees dans l'onglet
'donneesMAJ - le réarrangement des données se fait en mémoire
'
Dim feuilSrc As Worksheet
Dim feuilDest As Worksheet
Dim TabRng() As Variant
Dim derLig As Long, derCol As Long, cnt As Long, nb_sep As Long
Dim LigTotal As Long
With ThisWorkbook
Set feuilSrc = .Worksheets("DONNEES_BRUTES_10K")
Set feuilDest = .Worksheets("donneesMAJ_10K")
End With
'on efface les données de la feuille qui contient les
'résultats pour éviter toute confusion
feuilDest.Cells.ClearContents
With feuilSrc
.Activate
'dernière ligne des données non MAJ
derLig = [A1].End(xlDown).Row
'dernière colonne
derCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
'on copie les données dans le tableau TabRng()
TabRng = .Range(.Cells(1, 1), .Cells(derLig, derCol))
End With 'feuilSrc
'Traitement en mémoire ==>
For i = LBound(TabRng, 1) To UBound(TabRng, 1)
arr = Split(CStr(TabRng(i, COL_M)), ";")
cnt = UBound(arr, 1)
nb_sep = nb_sep + cnt
Next i
'le tableau en mémoire est base 0
'on diminue la dimension de la ligne de titre
nb_sep = nb_sep + derLig - 1
'vTab_1() est un tableau en mémoire initialisé
'de 2 dimensions ligne / colonne
ReDim vTab_1(nb_sep, derCol - 1) As String
'initialise les variables
cnt = 0: m = 0: nb_sep = 0
For j = LBound(TabRng, 1) To UBound(TabRng, 1)
'on boucle sur la colonne à partir de la ligne 2
'qui contient les éléments dans le tableau TabRng
'on compte le nombre de valeur dans la colonne E
'pour l'itération correspondante
arr = Split(CStr(TabRng(j, COL_M)), ";")
cnt = UBound(arr, 1)
's'il y a 2 valeurs ou +
If cnt > 0 Then
For k = LBound(arr, 1) To UBound(arr, 1)
'on boucle sur les valeurs du tableau arr()
For i = LBound(vTab_1, 2) To UBound(vTab_1, 2)
'on copie dans vTab_1 les données du tuple concerné
'qui contiennent plusieurs valeurs (pls machines)
If i + 1 = COL_M Then
'la colonne suivante est celle qui doit contenir
'les valeurs séparées
vTab_1(m, i) = LTrim(arr(k))
Else
'on copie simplement les autres données du tuple
'vTab_1(m, i) = .Cells(c.Row, i + 1)
vTab_1(m, i) = TabRng(j, i + 1)
End If
Next i
'on incremente vTab_1() d'autant de tuples à insérer
m = m + 1
Next k 'valeur suivante
Else
'il n'y a qu'une seule valeur / machine sur le tuple
'on copie simplement le tuple dans le tableau vTab_1()
For ii = LBound(vTab_1, 2) To UBound(vTab_1, 2)
vTab_1(m, ii) = TabRng(j, ii + 1)
Next ii
'on incrémente vTab()
m = m + 1
End If
Next j
'<== Traitement en mémoire
With feuilDest
.Activate
'on copie le tableau en mémoire vTab_1() dans l'onglet feuilDest
.Range(.Cells(1, 1), .Cells(UBound(vTab_1, 1) + 1, derCol)) = vTab_1
'on applique le style sur la ligne de titre
.Range(.Cells(1, 1), .Cells(1, derCol)).Font.Bold = True
.Range(.Cells(1, 1), .Cells(1, derCol)).HorizontalAlignment = xlCenter
'on réajuste la taille des colonnes
For i = 1 To 8
Columns(i).ColumnWidth = feuilSrc.Columns(i).ColumnWidth
Next i
Columns(COL_M).ColumnWidth = 25
End With 'feuilDest
Set rng = Nothing
With ThisWorkbook
Set feuilSrc = Nothing
Set feuilDest = Nothing
End With
End Sub
Ce script effectue tout le traitement en mémoire. Comparé à l'utilisation d'un objet range, ce script nécessite peu de mémoire disponible. Par contre,
Le script suivant reprend le script précédent avec des optimisations supplémentaires
Script 3-optimisations
Public Const COL_M = 5 'champs machine
Private Sub DonneesETL_v3_1()
'Routine qui sépare les données de la colonne "utilisateur" en colonne E
'sur des enregistrements distincts et copie les donnees dans l'onglet
'donneesMAJ - le réarrangement des données se fait en mémoire
'
'---
'edit 1: routine optimisée avec la gestion des paramètres de l'application
Dim feuilSrc As Worksheet
Dim feuilDest As Worksheet
Dim TabRng() As Variant
Dim derLig As Long, derCol As Long, cnt As Long, nb_sep As Long
Dim LigTotal As Long
With Application
' Copie des paramètres utilisateurs de l'application
screenUpdateStatus = .ScreenUpdating
statusBarStatus = .DisplayStatusBar
calcStatus = .Calculation
eventsStatus = .EnableEvents
End With
With ThisWorkbook
Set feuilSrc = .Worksheets("DONNEES_BRUTES_10K")
Set feuilDest = .Worksheets("donneesMAJ_10K")
End With
' Paramètre de la feuille de calcul
AffichageZoneImpression_feuilSrc = feuilSrc.DisplayPageBreaks
AffichageZoneImpression_feuilDest = feuilDest.DisplayPageBreaks
' Désactivation des paramètres utilisateur de l'application
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
' Désactivation pour Feuille de calcul
feuilSrc.DisplayPageBreaks = False
feuilDest.DisplayPageBreaks = False
'on efface les données de la feuille qui contient les
'résultats pour éviter toute confusion
feuilDest.Cells.ClearContents
With feuilSrc
.Activate
'dernière ligne des données non MAJ
derLig = [A1].End(xlDown).Row
'dernière colonne
derCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
'on copie les données dans le tableau TabRng()
TabRng = .Range(.Cells(1, 1), .Cells(derLig, derCol))
End With 'feuilSrc
'Traitement en mémoire ==>
For i = LBound(TabRng, 1) To UBound(TabRng, 1)
arr = Split(CStr(TabRng(i, COL_M)), ";")
cnt = UBound(arr, 1)
nb_sep = nb_sep + cnt
Next i
'le tableau en mémoire est base 0
'on diminue la dimension de la ligne de titre
nb_sep = nb_sep + derLig
'vTab_1() est un tableau en mémoire initialisé
'de 2 dimensions ligne / colonne
ReDim vTab_1(nb_sep, derCol - 1) As String
'initialise les variables
cnt = 0: m = 0: nb_sep = 0
For j = LBound(TabRng, 1) To UBound(TabRng, 1)
'on boucle sur la colonne à partir de la ligne 2
'qui contient les éléments dans le tableau TabRng
'on compte le nombre de valeur dans la colonne E
'pour l'itération correspondante
arr = Split(CStr(TabRng(j, COL_M)), ";")
cnt = UBound(arr, 1)
's'il y a 2 valeurs ou +
If cnt > 0 Then
For k = LBound(arr, 1) To UBound(arr, 1)
'on boucle sur les valeurs du tableau arr()
For i = LBound(vTab_1, 2) To UBound(vTab_1, 2)
'on copie dans vTab_1 les données du tuple concerné
'qui contiennent plusieurs valeurs (pls machines)
If i + 1 = COL_M Then
'la colonne suivante est celle qui doit contenir
'les valeurs séparées
vTab_1(m, i) = LTrim(arr(k))
Else
'on copie simplement les autres données du tuple
'vTab_1(m, i) = .Cells(c.Row, i + 1)
vTab_1(m, i) = TabRng(j, i + 1)
End If
Next i
'on incremente vTab_1() d'autant de tuples à insérer
m = m + 1
Next k 'valeur suivante
Else
'il n'y a qu'une seule valeur / machine sur le tuple
'on copie simplement le tuple dans le tableau vTab_1()
For ii = LBound(vTab_1, 2) To UBound(vTab_1, 2)
vTab_1(m, ii) = TabRng(j, ii + 1)
Next ii
'on incrémente vTab()
m = m + 1
End If
Next j
'<== Traitement en mémoire
With feuilDest
.Activate
'on copie le tableau en mémoire vTab_1() dans l'onglet feuilDest
.Range(.Cells(1, 1), .Cells(UBound(vTab_1, 1), derCol)) = vTab_1
'on applique le style sur la ligne de titre
.Range(.Cells(1, 1), .Cells(1, derCol)).Font.Bold = True
.Range(.Cells(1, 1), .Cells(1, derCol)).HorizontalAlignment = xlCenter
'on réajuste la taille des colonnes
For i = 1 To 8
Columns(i).ColumnWidth = feuilSrc.Columns(i).ColumnWidth
Next i
Columns(COL_M).ColumnWidth = 25
End With 'feuilDest
' Réactivation des paramètres utilisateur de l'application
With Application
.ScreenUpdating = screenUpdateStatus
.DisplayStatusBar = statusBarStatus
.Calculation = calcStatus
.EnableEvents = eventsStatus
End With
' Réactivation pour Feuille de calcul
feuilSrc.DisplayPageBreaks = AffichageZoneImpression_feuilSrc
feuilDest.DisplayPageBreaks = AffichageZoneImpression_feuilDest
With ThisWorkbook
Set feuilSrc = Nothing
Set feuilDest = Nothing
End With
End Sub
Cet exemple montre la structure d'un script vba qui n'est pas le résultat de l'enregistrement d'une macro.
Ces scripts montrent l'utilisation des