Barre de progression

[jeandechanel]

Bonjour chers tous!
je voudrais insérer une barre de progression dans la macro ci-dessous. cette macro regroupe les articles d'une base de données en familles d'articles. exemple : les bonbons s'il y'en a plusieurs types etc.

Public Function trifamille(MaColonne As Long)
       Dim ligne As Integer, j As Integer
       Dim varLi1 As String, varLi2 As String
       Dim Compteur As Long, var As Long
       Dim TV As Variant, TL() As Variant
On Error GoTo suite     'sortie si erreur avec defige ecran
                     Application.ScreenUpdating = False      'fige ecran
       With Worksheets("Feuil1")
            TV = .Range("A1").CurrentRegion
            If MsgBox("Veuillez confirmer s'il vous plait !", vbYesNo + vbExclamation, "Insertion de lignes vides") = vbYes Then
       For ligne = 3 To UBound(TV) - 1
           varLi1 = Cells(ligne, MaColonne)
           varLi2 = Cells(ligne + 1, MaColonne)
           If Left(varLi1, 4) <> Left(varLi2, 4) Then
              ReDim Preserve TL(j)
              TL(j) = ligne + 1
              j = j + 1
           End If
       Next ligne
       For j = UBound(TL) To LBound(TL) Step -1
           .Rows(TL(j)).Insert shift:=xlShiftDown
           .Rows(TL(j)).Insert shift:=xlShiftDown
           Compteur = Compteur + 1
       Next j
           Else
              Exit Function
           End If

              MsgBox Compteur - 1 & " Lignes vides inserees avec succes !", _
              vbInformation, _
              "Macro_Insere_Lignes_Vides"
       End With
suite:
       Application.ScreenUpdating = True       'defige ecran
End Function

 

[Dranreb]

Bonsoir.
Pourquoi, après avoir tout chargé dans un tableau dynamique TV continuez vous de travailler avec les cellules, alors que tout est déjà dans ce tableau, non ?
Une procédure utilisant ma Function Gigogne vous ferait ça en un rien de temps.
Joignez un modèle du classeur, que je puisse tester une proposition ultérieure.

 

[Dranreb]

Sinon ça déjà devrait être assez rapide :

Option Explicit
Sub TriFamille(ByVal Col As Long)
   Dim Rng As Range, TEnt(), TSor(), LE As Long, LS As Long, C As Long
   Set Rng = Worksheets("Feuil1").[A1].UsedRange
   TEnt = Rng.Value
   ReDim TSor(1 To 2 * UBound(TEnt, 1), 1 To UBound(TEnt, 2))
   For LE = 1 To 3: For C = 1 To UBound(TEnt, 2)
      TSor(LE, C) = TEnt(LE, C)
      Next C, LE
   LS = 3
   For LE = 4 To UBound(TEnt, 1)
      If TEnt(LE, Col) <> TEnt(LE - 1, Col) Then LS = LS + 1
      LS = LS + 1
      For C = 1 To UBound(TEnt, 2)
         TSor(LS, C) = TEnt(LE, C)
         Next C, LE
   Rng.Resize(LS).Value = TSor
   End Sub

À tester, forcément.

 

[jeandechanel]

Bonsoir.
Pourquoi, après avoir tout chargé dans un tableau dynamique TV continuez vous de travailler avec les cellules, alors que tout est déjà dans ce tableau, non ?
Une procédure utilisant ma Function Gigogne vous ferait ça en un rien de temps.
Joignez un modèle du classeur, que je puisse tester une proposition ultérieure.

bonjour Dranreb, mon programme fonctionne correctement. sauf que j'ai voulu insérer une barre de progression a cette macro juste pour apprendre à le faire! et cette macro je l'ai choisis au hasard parmi tant d'autres. donc mon objectif est d'apprendre à insérer une BARRE DE PROGRESSION à mes macros. merci

 

[jeandechanel]

Sinon ça déjà devrait être assez rapide :

Option Explicit
Sub TriFamille(ByVal Col As Long)
   Dim Rng As Range, TEnt(), TSor(), LE As Long, LS As Long, C As Long
   Set Rng = Worksheets("Feuil1").[A1].UsedRange
   TEnt = Rng.Value
   ReDim TSor(1 To 2 * UBound(TEnt, 1), 1 To UBound(TEnt, 2))
   For LE = 1 To 3: For C = 1 To UBound(TEnt, 2)
      TSor(LE, C) = TEnt(LE, C)
      Next C, LE
   LS = 3
   For LE = 4 To UBound(TEnt, 1)
      If TEnt(LE, Col) <> TEnt(LE - 1, Col) Then LS = LS + 1
      LS = LS + 1
      For C = 1 To UBound(TEnt, 2)
         TSor(LS, C) = TEnt(LE, C)
         Next C, LE
   Rng.Resize(LS).Value = TSor
   End Sub

À tester, forcément.

bonjour Dranreb, je vous remercie pour l'aide que vous voulez m'apporter. voici en pièces-jointes le fichier sur lequel ma macro travail. l'onglet "Feuil1" est le fichier d'origine et l'onglet "Resultat" est bien évidemment le résultat attendu. merci pour votre contribution.

 

[Dranreb]

Bonjour.
Il y a deux Function TriFamille dans votre classeur. Aucune des deux ne retourne de valeur. Lequel des deux module puis-je supprimer ?

 

[Dranreb]

D'habitude je propose ça pour les barres de progression

Je le re-joins parce qu'il y avait trop de problèmes avec votre code.

 

[jeandechanel]

D'habitude je propose ça pour les barres de progression

Je le re-joins parce qu'il y avait trop de problèmes avec votre code.

Grand merci pour aide précieuse Dranreb. après une ou deux retouches mineures le programme fonctionne a merveille. une fois de plus merci.