info2gestion

Accueil

Développement VBA

Scripts gestion de données - exemples

Développement VBA – Exemple automatisation

Cet exemple montre des données qui ne sont pas normalisées au sens d'une base de données relationnelle et qui nécessitent un retraitement.

Cette automatisation pourrait être réalisée avec une requête sql. Du fait que les données ne sont pas normalisées, la création de la requête pourrait être assez technique ou nécessiter d'utiliser des tables temporaires.

L'utilisation du module OLAP PowerQuery peut également s'appliquer à cet exemple.

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

Exemple du retraitement

La boite de dialogue de l'enregistreur de macro

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 méthode insert est répétée autant de fois qu'il y a de données à ajouter.



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 4GO de mémoire et un processeur i5 de 2ghz, sur 10K lignes, le traitement par ce script est de 2 ou 3 secondes avec un taux d'utilisation du processeur de plus de 40%.

Le script ci-dessous copie les données dans un objet range et le traitement se fait sur cet objet. Ce script est de 1/10ème à 1/100ème du temps de traitement du script précédent.

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. L'objet range est rapide mais peut nécessiter une certaine quantité de mémoire disponible.

Ce script peut être équivalent à l'emploi des objets collections. Dans le script précédent et suivant, les tableaux sont crées et dimensionnés simultanément. Sur un volume de données conséquent, il est préferable d'éviter la méthode redim Preserve...

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, s'il y avait des calculs, l'utilisation de l'objet range permettrait d'accéder aux fonctions et méthodes de la feuille de calcul excel.

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 boucles, des conditions et les modes d'accès mémoire en vba dans un style de programmation procédural ou fonctionnel.