Microsoft 365 Comparer le texte de deux colonnes (plusieurs mots/cellule) pour trouver 1 mot en commun

L

Lagertha

Guest
Bonjour à tous!
Je suis toute fraîchement arrivée ici et je vous découvre en faisant mes recherches depuis plusieurs jours sur ma problématique.
Je n'y ai pas encore trouvé de solution. Je vous l'expose en espérant que vos lumière me sauveront.

Je pars d'une liste de noms de dossier en colonne A (environ 22 000 lignes)

J'ajoute en colonne B, quotidiennement, une liste de dossiers qui me vient de l'internationale pour vérifier que nous n'avons pas les mêmes clients pour des missions qui seraient en conflit. Cette liste ne contient pas plus de 50 lignes.

La difficultés: chaque cellule de la colonne A et B comprend plusieurs mots (nom de la société, parfois la branche de la filiale, ...).
Il me faut tester chaque cellule de la colonne B pour vérifier qu'au moins un mot ne se trouve pas dans ma colonne A. Je ne cherche donc pas des cellules identiques (donc pas de RECHERCHE, etc...) mais des cellules qui auraient au moins un mot en commun (sans tenir compte de la casse).
J'ai testé quelques macros trouvées sur le site mais elles ne permettent la comparaison que de deux cellules de la même ligne. Je suis vraiment perdue.

Exemple joint.

Je vous remercie par avance pour toute l'aide que vous pourriez m'apporter
 

Pièces jointes

  • Comparaison des deux colonnes.xlsx
    9.2 KB · Affichages: 14
Dernière modification par un modérateur:

Lolote83

XLDnaute Barbatruc
Bonjour à tous,
@Lagertha à dit :
La difficultés: chaque cellule de la colonne A et B comprend plusieurs mots (nom de la société, parfois la branche de la filiale, ...).
Il me faut tester chaque cellule de la colonne B pour vérifier qu'au moins un mot ne se trouve pas dans ma colonne A.
Donc, de ce que j'ai compris, si dans la colonne B, il y a deux mots (ex : Had Bad ou Dal Bel ou Sam Zia .....) il faut chercher dans la colonne A, si le mot Had existe puis le mot Bad et ainsi de suite et non pas la combinaison Had Bad.
- Pour @RyuAutodidacte , je ne retrouve pas ceci dans votre fichier (ou alors mal interprété le résultat)
- Pour @laurent950, j'ai une erreur dans l'exécution du code
1694945154060.png

- Pour @mapomme, je ne retrouve pas ceci dans votre fichier (ou alors mal interprété le résultat)

Donc au final, peut être ai-je mal interprété la demande. Je ne sais plus en fait.
De plus que @Lagertha ne s'est toujours pas manifestée depuis pour avoir son avis.
Bon week-end à tous
@+ Lolote83
 

laurent950

XLDnaute Barbatruc
Re @Lolote83

Il faut ajouter On Error Resume Next

VB:
Private Sub UserForm_Initialize()
    On Error Resume Next
    ' Initialise la barre de progression
    Me.LabelProgress.Caption = "Progression : 0%"
    Me.ProgressBar1.Value = 0
    Me.ProgressBar1.Min = 0
    Me.ProgressBar1.Max = 100
End Sub

Sans les numéros de lignes c'est plus claire ?
 

Pièces jointes

  • SansNumLigne_ComparaisonDesDeuxColonnes-Regex-ColorTxt-Adresse(ComplexeModuledeClasse).xlsm
    43.8 KB · Affichages: 5
Dernière édition:

RyuAutodidacte

XLDnaute Impliqué
Bonjour le fil

@RyuAutodidacte
Tu parles de ceci ?
;)
Re,

@Staple1600

Je l'ai pas encore ouvert mais je suppose que oui
J'ai été son padawan sur un autre forum, et sur mon post, il a eu la gentillesse de me créer
un module de classe Dictionnaire pour Collection ici
Grace à lui j'ai énormément évolué en vba (et bien sur d'autres personne comme notre ami patricktoulon)
Mais le plus gros de mon apprentissage c'était avec Marc-L dont je lui suis entièrement reconnaissant 😍

Edit : je reconnais bien son avatar :D
 
Dernière édition:

Lolote83

XLDnaute Barbatruc
Re bonjour,
Dans mon exemple, j'ai effectivement afficher un label comme si c'était une progress bar.
Par contre, dans votre exemple, il y a un label + un control progressbar ? Du coup, quand j'ai rajouté mon propre control progressBar dans votre exemple, cela a fonctionné. Ce que je ne comprend pas c'est pourquoi, si vous avez vous aussi chargé un progressbar, celui-ci n'a pas été reconnu au lancement de la macro et donc qu'il m'a fallu en reconstruire une.
Par contre, je n'ai pas vraiment compris :
Le code est plus clair (avec ou sans) les numéros de lignes ?
Poste #12 (avec Numéros de Lignes) ?
Poste #20 (sans Numéros de lignes) ?
@+ Lolote83
 

laurent950

XLDnaute Barbatruc
Re @Lolote83

Le code est plus clair (avec ou sans) les numéros de lignes ?
Poste #12 (avec Numéros de Lignes) ?
1694971648297.png

Poste #20 (sans Numéros de lignes) ? [Le Mot] ; [Le Mot Suivant]
1694971686629.png

Il y a deux affichages pour cette progress barre
- Le label pour les parties traitées.
- la progress barre l'avancement.

1694949075164.png


Part 1/2, Celle ou je remplis le module de classe avec la variable collection
- Col.Add Item:=Res, Key:=TDon(j) ' ........... MetaDonnées Mot Colonne A
- Re remplit le module de classe
- Je consigne cette classe dans la variable collection avec la clé = Le mot

Part 2/2, Celle qui va remplir l'information de la colonne B avec les informations trouvées dans le module de classe qui correspond à la clé
- For Each élément In Col
- Set Res = élément
- pattern = Res.Key ' J'utilise une expression régulière qui peut être réglée par la suite
- Ce qui est long c'est cette partie de code
- Mettez en couleur la correspondance dans la cellule de la colonne A
- Je n'ai pas tout détaillé le code mais c'est l'idée.
 
Dernière édition:

RyuAutodidacte

XLDnaute Impliqué
- Pour @RyuAutodidacte , je ne retrouve pas ceci dans votre fichier (ou alors mal interprété le résultat)
Bonjour @Lolote83 ,

Dans l'exemple donnée par @Lagertha (plus que minime)
1694949738659.png

La difficultés: chaque cellule de la colonne A et B comprend plusieurs mots (nom de la société, parfois la branche de la filiale, ...).
Il me faut tester chaque cellule de la colonne B pour vérifier qu'au moins un mot ne se trouve pas dans ma colonne A. Je ne cherche donc pas des cellules identiques (donc pas de RECHERCHE, etc...) mais des cellules qui auraient au moins un mot en commun (sans tenir compte de la casse).
J'ajoute en colonne B, quotidiennement, une liste de dossiers qui me vient de l'internationale pour vérifier que nous n'avons pas les mêmes clients pour des missions qui seraient en conflit. Cette liste ne contient pas plus de 50 lignes.
D'après ce que j'ai compris, et pour ma part les "ok" sont les dossier sur lesquelles ils peuvent travailler et les cellule vides dans la colonne test les dossiers sur lesquelles ils rentrent en conflits

Dans mon code j'ai rempli dans une collection chaque mot (entier) en clé de la colonne A pour vérifier les mots (entier) de la colonne B
J'aurais pu inverser la logique en commençant par la colonne B et j'aurais eu le même résultat …

Le résultat sur mon code :
1694950731522.png


j'ai le même résultat que l'exemple de @Lagertha
Avec un filtre automatique et un mise en forme conditionnelle c'est très rapide de ce focus sur ce que l'on veut

PS : la barre de progression c'est bien mais vu que pour 23 000 lignes le code dure moins de 1 seconde
je ne suis pas sure que cela soit utile
 

laurent950

XLDnaute Barbatruc
Bonsoir @Lolote83
'
Pour vos question en Poste #16 / 19 / 21 / 22
'
Re bonjour,
Dans mon exemple, j'ai effectivement afficher un label comme si c'était une progress bar.
Par contre, dans votre exemple, il y a un label + un control progressbar ? Du coup, quand j'ai rajouté mon propre control progressBar dans votre exemple, cela a fonctionné. Ce que je ne comprend pas c'est pourquoi, si vous avez vous aussi chargé un progressbar, celui-ci n'a pas été reconnu au lancement de la macro et donc qu'il m'a fallu en reconstruire une.
Par contre, je n'ai pas vraiment compris :
'
J'ai fait l'exemple de la Progress Barre de vos questions à vos Poste.
AvecProgressBarreCréationd'uneProgressBarreExplication.xlsm
'
J'ai remplacer la ProgressBarre initial par une Progressbarre avec Label.
AvecLabelCréationd'uneProgressBarreExplication.xlsm

Alors les les Poste #12 (Avec Numéros de lignes)
1694975475666.png

et le Poste #20(Sans Numéros de lignes)
1694975496771.png

Cela devrait être OK.
'
Puis j'ai ajouté au Module de classe : (Pour décharger les variables de ce module de class)
Private Sub Class_Terminate()
'
Bien que je n'ai pas déchargé les variables dans le module standard a la fin, a suivre.
'
Je vous Poste les deux modèle @Lolote83
ProgressBarre avec 2 Label
'
Puis celui de vos questions en Poste #16 / 19 / 21 / 22
ProgressBarre avec 1 Label et ProgressBarre
1694973640953.png


Si quelqu'un souhaite le mode d'emplois pour créer la Progresse barre label
je peux poster toutes la procédure en partant d'un nouveau classeur Excel.
 

Pièces jointes

  • AvecLabelCréationd'uneProgressBarreExplication.xlsm
    48.9 KB · Affichages: 5
  • AvecProgressBarreCréationd'uneProgressBarreExplication.xlsm
    111 KB · Affichages: 8
Dernière édition:

RyuAutodidacte

XLDnaute Impliqué
Bonsoir @Lolote83
'
Pour vos question en Poste #16 / 19 / 21 / 22
'

'
J'ai fait l'exemple de la Progress Barre de vos questions à vos Poste.
AvecProgressBarreCréationd'uneProgressBarreExplication.xlsm
'
J'ai remplacer la ProgressBarre initial par une Progressbarre avec Label.
AvecLabelCréationd'uneProgressBarreExplication.xlsm

Alors les les Poste #12 (Avec Numéros de lignes)
Regarde la pièce jointe 1178947
et le Poste #20(Sans Numéros de lignes)
Regarde la pièce jointe 1178948
Cela devrait être OK.
'
Puis j'ai ajouté au Module de classe : (Pour décharger les variables de ce module de class)
Private Sub Class_Terminate()
'
Bien que je n'ai pas déchargé les variables dans le module standard a la fin, a suivre.
'
Je vous Poste les deux modèle @Lolote83
ProgressBarre avec 2 Label
'
Puis celui de vos questions en Poste #16 / 19 / 21 / 22
ProgressBarre avec 1 Label et ProgressBarre
Regarde la pièce jointe 1178939

Si quelqu'un souhaite le mode d'emplois pour créer la Progresse barre label
je peux poster toutes la procédure en partant d'un nouveau classeur Excel.
Bonjour le fil,

@laurent950
Étant donné que je suis sur Mac je préfère de mon coté la compatibilité multi-platefome Mac/PC
Je penche donc pour cette version :
AvecLabelCréationd'uneProgressBarreExplication.xlsm

Avec l'autre version ca bug … une référence surement qui n'existe que pour Windows …
 
L

Lagertha

Guest
Re bonjour @Lagertha,
Voici la Version 3 qui normalement prend en compte uniquement l'exactitude des mots.

Je pense qu'avec cette version, la demande devrait du coup mieux correspondre.
A tester.
Merci du retour
Cordialement
Lolote83
Bonjour @Lolote83 et merci pour votre travail.
J'ai tenté, depuis vendredi, à plusieurs reprises, de faire fonctionner ces deux derniers fichiers avec les listes que je traite mais hélas, à chaque fois, l'outil Excel à cessé de fonctionné, tout à planté et je n'ai pas eu d'autres choix que de forcer l'arrêt du programme. C'était le cas encore à l'instant et j'en suis désolée...
 
L

Lagertha

Guest
Bonsoir @Lagertha @Lolote83 @djidji59430

Copier en colonne A : vos liste de noms de dossier (environ 22 000 lignes)
Copier en colonne B : vos liste de noms de dossier de l'internationale (environ 50 lignes)

Le Programme ci-dessous fait tous le reste.
Au Plaisir de vous lire et de connaitre votre retour.

Cela devrait être super rapide en temps de traitement pour 80 000 Ligne en colonne A

Pour info en retour, combien de temps pour le traitement de la colonne A ?
Combien de Ligne en Colonne A = ?
Combien de Ligne en Colonne B = ?
j'ai vraiment optimisé pour que cela soit Ultra Rapide !

Module Standard(ModStandardColl)
VB:
Option Explicit
Sub FindPatternInRangeColor()
' A Partir de la Lignes 2 Colonne A et B
' Colonne A (Coller la Liste de + 20 000 Lignes)
' Colonne B (Coller La Liste de + 50 Lignes)
' Test :
' Pour Chaques cellule de la colonne B
'   Alors Chaque mot de cette cellule
'   Sera comparer a tous les Mots de toutes les céllule de la colonne A
'   Exemple :
'       - Cellule B7 = 2 Mots ---->> "Ani Tan"
'               - Alors : le resulat [Tan] Lig N° : 13; [Ani] Lig N° : 13; 14; 15
'     En Colonne A --->>> Tan ce trouve en Ligne 13 et Ani ce trouve en Ligne 13 ; 14 et 15
'     En Colonne B ce qui est trouvé en Colonne A est Colorié en Rouge pour le Texte
'   Alors en
'     En Colonne A --->>> Tan ce trouve en Ligne 13 le Mot Tan est colorié en Rouge
'     En Colonne A --->>> Ani ce trouve en Ligne 13; 14; 15 les Mots Ani sont colorié en Rouge
'
    Dim t ' .................................. 0
    Dim ws As Worksheet ' ............................ 1
    Dim rng As Range ' ............................... 2
    Dim Res As ModClasseColl ' ....................... 3
    Dim Val As Range ' ............................... 4
    Dim TDon As Variant ' ............................ 5
    Dim j As Byte ' .................................. 6
    Dim Lig As String ' .............................. 8
    Dim Col As Collection ' .......................... 9
    Dim élément As ModClasseColl ' ................... 10
    Dim regex As Object ' ............................ 11
    Dim pattern As String ' .......................... 12
    Dim matches As Object ' .......................... 13
    Dim match As Object ' ............................ 14
    Dim cell As Range ' .............................. 15
    Dim Tcolor() As Range ' .......................... 16
    Dim k As Long ' .................................. 17
    Dim Separator As String ' ........................ 18
    Dim startPos As Long ' ........................... 19
    Dim endPos As Long ' ............................. 20
    Dim Progress As Long ' ........................... 21
    Dim ZoneTraité As String ' ....................... 22
    Dim CptColProgsBarre As Long ' ................... 23
    Dim TabLigColA() As String ' ..................... 23
    Dim MotTabLigColA As String ' .................... 23
 
    Application.ScreenUpdating = False
 
    ' 0) Spécifiez le temps de traitement des données
        t = Timer
 
    ' 1) Spécifiez la feuille de calcul et la plage dans laquelle vous souhaitez rechercher
        Set ws = ThisWorkbook.Worksheets(ActiveSheet.Name)
 
    ' 2) Changer cette plage en fonction de vos besoins
        Set rng = ws.Range(ws.Cells(2, 1), ws.Cells(ws.Cells(1048576, 1).End(xlUp).Row, 2))
 
    ' 9) La collection qui contient le Module de Classe
            Set Col = New Collection
      
    ' ** ) Barre de progression
           Progress = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row - 1 ' ......... Comptes les élèments
           'UserForm1.Show vbModeless ' ....................................... Affiche la UserForm en mode non modal
           UsfProgressBarr.Show vbModeless ' ................................. Affiche la UserForm en mode non modal
           ZoneTraité = " Part 1/2 : Scan tous les Mots de la colonne A" ' ... Partie Traité
 
    ' *) 4 = Val | 5 = TDon | 6 = j | 7 = Lig | 3 = Res
            For Each Val In rng.Resize(ws.Cells(ws.Rows.Count, 1).End(xlUp).Row - 1, 1)
                TDon = Split(Trim(Val.Value), " ")
                    For j = LBound(TDon) To UBound(TDon)
                        ' Gestion d'erreur
                        On Error Resume Next
                            If Exists(Col, TDon(j)) = False Then
                                ' Le Module de Classe
                                    Set Res = New ModClasseColl
                                ' Remplire Le Module de Classe
                                    Res.Col = Split(Val.Address, "$")(1) ' ....... Colonne Lettre (du Mot)
                                    Res.Lig = CStr(Val.Row) ' .................... Ligne N° (du Mot)
                                Set Res.Add = Val ' .............................. Adresse Ligne (du Mot)
                                    Res.Key = TDon(j) ' .......................... Le Mot (du Mot)
                                    Res.Init ' ................................... Remplis le Tableau Ligne et Adresse
                                ' Stock le Module de Classe dans la collection
                                    Col.Add Item:=Res, Key:=TDon(j) ' ........... MetaDonnées Mot Colonne A
                            Else
                                ' Le Module de Classe
                                    Set Res = Col.Item(TDon(j))
                                ' Stock le Module de Classe dans la collection
                                ' Provoque une erreur
                                ' Modifier et Remplire Le Module de Classe avec les nouvelles valeurs
                                    Col.Add Item:=Res, Key:=TDon(j) ' ......................... N
                                        If Err <> 0 Then
                                            'Lig = Res.Lig & "; " & Val.Row ' ......... Les Numéros des Ligne (du Mot) ' Res.Lig Mange trop de mémoire
                                            'Res.Lig = Lig ' ........................... Ligne N° (du Mot) ' Res.Lig Mange trop de mémoire
                                            Res.Lig = CStr(Val.Row) ' .................... Ligne N° (du Mot)
                                        Set Res.Add = Val ' ....................... Adresse Ligne (du Mot)
                                            Res.Init ' ................................ Remplis le Tableau Ligne et Adresse
                                            Col.Remove (TDon(j))
                                            Col.Add Item:=Res, Key:=TDon(j)
                                            Lig = Empty
                                        End If
                            On Error GoTo 0
                            End If
                    Next j
            ' Met à jour la barre de progression
            'UserForm1.UpdateProgressBar Val.Row / Progress, ZoneTraité
             UsfProgressBarr.UpdateProgressBar Val.Row, Progress, ZoneTraité
            Next Val
            On Error GoTo 0
      
'   Ferme la UserForm lorsque la macro est terminée
            'Unload UserForm1
            Unload UsfProgressBarr
            Progress = Empty: ZoneTraité = Empty

'   Efface le précedent resultat de la colonne B
        rng.Offset(, 2).Resize(ws.Cells(ws.Rows.Count, 2).End(xlUp).Row - 1, 1).Clear

'   Efface le précedent Format des cellule en Rouge resultat de la colonne A
        rng.Offset(, 0).Resize(ws.Cells(ws.Rows.Count, 1).End(xlUp).Row - 1, 1).Interior.ColorIndex = xlNone
        rng.Offset(, 0).Resize(ws.Cells(ws.Rows.Count, 1).End(xlUp).Row - 1, 1).Font.ColorIndex = xlAutomatic

'   Efface le précedent Format des cellule en Rouge resultat de la colonne B
        rng.Offset(, 1).Resize(ws.Cells(ws.Rows.Count, 2).End(xlUp).Row - 1, 1).Interior.ColorIndex = xlNone
        rng.Offset(, 1).Resize(ws.Cells(ws.Rows.Count, 2).End(xlUp).Row - 1, 1).Font.ColorIndex = xlAutomatic

    ' ** ) Barre de progression
           Progress = Col.Count ' ......... Comptes les élèments
           'UserForm1.Show vbModeless ' ....................................... Affiche la UserForm en mode non modal
           UsfProgressBarr.Show vbModeless ' ....................................... Affiche la UserForm en mode non modal
           ZoneTraité = " Part 2/2 : Identifie les Mots de la colonne B Présent dans Colonne A" ' ... Partie Traité

'   Parcourir tous les éléments du dictionnaire
    For Each élément In Col
        CptColProgsBarre = CptColProgsBarre + 1
        Set Res = élément ' ................................................. Le Module de Classe
            pattern = Res.Key ' ............................................. Spécifiez le motif (pattern) que vous recherchez
        Set regex = CreateObject("VBScript.RegExp") ' ....................... Créez un objet RegExp
            With regex
                .Global = True ' ............................................ Recherchez toutes les correspondances dans chaque cellule
                .IgnoreCase = True ' ........................................ Ignorez la casse (en fonction de vos besoins)
                .pattern = pattern ' ........................................ Le Pattern (Ici le Mot)
            End With
'
'       Bouclez à travers chaque cellule dans la plage de la colonne A
'       rng.Offset(, 1).Resize(ws.Cells(ws.Rows.Count, 2).End(xlUp).Row - 1, 1).Select
            For Each cell In rng.Offset(, 1).Resize(ws.Cells(ws.Rows.Count, 2).End(xlUp).Row - 1, 1)
                TDon = Split(Trim(cell.Value), " ") ' ........................... Découpage de la chaine / " "
                    For j = LBound(TDon) To UBound(TDon)
                        Set matches = regex.Execute(TDon(j)) ' .................. Recherchez des correspondances dans le contenu de la cellule
'
'                           Vérifiez si des correspondances ont été trouvées
                            If matches.Count > 0 Then
'                               Traitez les correspondances ici
'                               Par exemple, vous pouvez afficher les correspondances dans la fenêtre de l'IDE
                                For Each match In matches
                                    'Debug.Print "Correspondance trouvée dans la cellule " & cell.Address & ": " & match.Value
                                    ' 1)
                                    ' Trouvé en Colonne A sur les Numéro de ligne
                                        TabLigColA = Res.Tlig
                                        ReDim Preserve Tcolor(UBound(TabLigColA) - 1)
                                        MotTabLigColA = Join(TabLigColA, "; ")
                                        MotTabLigColA = Left(MotTabLigColA, Len(MotTabLigColA) - 2)
                                    ' Définissez le séparateur
                                      Separator = "; "
                                        If cell.Offset(, 1).Value <> "" Then
                                            cell.Offset(, 1).Value = cell.Offset(, 1).Value & Separator
                                        End If
                                        cell.Offset(, 1).Value = cell.Offset(, 1).Value & "[" & TDon(j) & "] Lig N° : " & MotTabLigColA ' Res.Lig Mange trop de mémoire
                                    ' 2)
                                    ' Option : Format Text cellule de la colonne A
                                    '  Mettez en couleur la correspondance dans la cellule de la colonne A
                                    '  Obtenez les positions de début et de fin de la correspondance dans la cellule
                                    '  A l'aide du tableau d'adresse Res.TAdd
                                        Tcolor = Res.TAdd
                                        ReDim Preserve Tcolor(UBound(Tcolor) - 1)
                                        For k = LBound(Tcolor) To UBound(Tcolor)
                                            startPos = InStr(1, Tcolor(k).Value, match.Value, vbTextCompare)
                                            endPos = startPos + Len(match.Value) - 1
                                    ' Mettez en couleur la correspondance dans la cellule
                                            Tcolor(k).Characters(startPos, Len(match.Value)).Font.Color = RGB(255, 0, 0) ' Couleur rouge
                                        Next k
'                                 ' 3)
                                    ' Option : Format Text cellule de la colonne B
                                            startPos = InStr(1, cell.Value, match.Value, vbTextCompare)
                                            endPos = startPos + Len(match.Value) - 1
                                    ' Mettez en couleur la correspondance dans la cellule
                                            cell.Characters(startPos, Len(match.Value)).Font.Color = RGB(255, 0, 0) ' Couleur rouge
                                Next match
                            End If
                    Next j
            Next cell
        ' Met à jour la barre de progression
        'UserForm1.UpdateProgressBar CptColProgsBarre / Progress, ZoneTraité
        UsfProgressBarr.UpdateProgressBar CptColProgsBarre, Progress, ZoneTraité
    Next élément
'   Ferme la UserForm lorsque la macro est terminée
        'Unload UserForm1
        Unload UsfProgressBarr
        Progress = Empty: ZoneTraité = Empty
'
   MsgBox Timer - t
Application.ScreenUpdating = True
End Sub
'
Function Exists(ByRef Col As Collection, ByVal Key As String) As Boolean
' Le code suivant vérifie si une clé existe
    On Error GoTo EH
    IsObject (Col.Item(Key))
    Exists = True
EH:
End Function

Module de Classe(ModClasseColl)
Code:
Option Explicit
Private mCol As String
Private mLig As String
Private mAdd As Range
Private mKey As String
Private mTlig() As String
Private mTAdd() As Range
' ***************************************************************************************************************************
Property Get Col() As String
' Renvoi la valeur de la colonne
   Col = mCol
End Property
Property Let Col(ByVal NewValue As String)
' Mise à jour la valeur de la colonne
   mCol = NewValue
End Property
'
Property Get Lig() As String
' Renvoi la valeur de la colonne
   Lig = mLig
End Property
Property Let Lig(ByVal NewValue As String)
' Mise à jour la valeur de la colonne
   mLig = NewValue
End Property
'
Property Get Add() As Range
' Renvoi la valeur de la colonne
  Set Add = mAdd
End Property
Property Set Add(ByVal NewValue As Range)
' Mise à jour la valeur de la colonne
  Set mAdd = NewValue
End Property
'
Property Get Key() As String
' Renvoi la valeur du Mot recherché
   Key = mKey
End Property
Property Let Key(ByVal NewValue As String)
' Mise à jour de la valeur du Mot recherché
   mKey = NewValue
End Property
' ===========================================================================================================================
Property Get Tlig() As String()
' Renvoi la valeur du numéro de ligne du Mot recherché
   Tlig = mTlig
End Property
'
Property Get TAdd() As Range()
' Renvoi la valeur de l'adresse du Mot recherché
   TAdd = mTAdd
End Property
' ===========================================================================================================================
Private Sub Class_Initialize()
    ReDim Preserve mTlig(0 To 0)
    ReDim Preserve mTAdd(0 To 0)
End Sub
'
Public Sub Init()
' Mise à jour de la valeur du numéro de ligne du Mot recherché
        mTlig(UBound(mTlig)) = Me.Lig
' Mise à jour de la valeur la valeur de l'adresse du Mot recherché
   Set mTAdd(UBound(mTAdd)) = Me.Add
' Dimenssion des tableau
    ReDim Preserve mTlig(0 To UBound(mTlig) + 1)
    ReDim Preserve mTAdd(0 To UBound(mTAdd) + 1)
End Sub
'
Private Sub Class_Terminate()
    ' Code de nettoyage à effectuer ici

    ' Par exemple, vous pouvez réinitialiser les propriétés de la classe
    mCol = Empty
    mLig = Empty
    Set mAdd = Nothing
    mKey = Empty
 
    ' Libérer les tableaux
    Erase mTlig
    Erase mTAdd
End Sub

UserForm Progress Barre Label Name : (UsfProgressBarr)
Part 1 (UsfProgressBarr)
Code:
Private Sub UserForm_Initialize()
    ' Initialisez la barre de progression (Label) avec une couleur de fond et une largeur nulle
    LabelProgressBar.Width = 0
    LabelProgressBar.BackColor = RGB(0, 128, 0) ' Couleur de fond verte initiale
End Sub

Part 2 (UsfProgressBarr)
Code:
Sub UpdateProgressBar(CurrentProgress As Long, MaxProgress As Long, ByVal Zone As String)
    ' Mettez à jour la barre de progression (Label) en fonction de la valeur de progression (0 à 100)
    Dim ProgressPercentage As Double
    ProgressPercentage = CurrentProgress / MaxProgress
 
    ' Calculez la nouvelle largeur du Label pour représenter la progression
    Me.LabelProgress.Caption = "Progression : " & Format(ProgressPercentage, "0%") & Zone
    Me.LabelProgressBar.Width = ProgressPercentage * Me.Width
 
    DoEvents ' Permet de rafraîchir l'interface utilisateur
End Sub

Laurent950
Bonjour @laurent950,
Merci pour votre travail. Il semblerait que le traitement soit plus rapide que ce que j'ai testé précédemment, hélas je n'ai pas de résultat. Je vous joins une capture d'écran.
 

Pièces jointes

  • laurent950 message d'erreur.PNG
    laurent950 message d'erreur.PNG
    9 KB · Affichages: 10

Discussions similaires

Réponses
16
Affichages
1 K

Statistiques des forums

Discussions
313 198
Messages
2 096 141
Membres
106 505
dernier inscrit
ngomez