XL 2016 travail sur tableau

finarobert à dit:

je n'arrive pas envoyer des infos car fichier trop volumineux
je découpe : réalité c'est le résultat attendu pour l'onglet
vba est le résultat de la macro et je vais découper le fichier de ase en deux fichiers point1 et point2

Cliquez pour agrandir...

laurent950 à dit:

Bonjour Le Forum @finarobert

VBA avec votre fichier en Poste #2

VB:

Sub Programme2Bis_Doublons_Regex_Mot()

    Dim wsSrc As Worksheet, wsDst As Worksheet
    Dim lastRow As Long, i As Long, outRow As Long
    Dim idCourant As String, ligneIdentite As String
    Dim dict As Object
    Dim ta As String, tb As String
    Dim arrKeys() As Variant, k As Long
    Dim tmp As Variant
    Dim currentMot As String
    Dim lignes() As String, idx As Long
 
    Dim reg As Object, Matches As Object, m As Object
 
    ' Feuilles
    Set wsSrc = ThisWorkbook.Sheets("solution")
    On Error Resume Next
    Set wsDst = ThisWorkbook.Sheets("doublons")
    On Error GoTo 0
    If wsDst Is Nothing Then
        Set wsDst = ThisWorkbook.Sheets.Add
        wsDst.Name = "doublons"
    End If
 
    ' Effacer l'onglet résultats
    wsDst.Cells.Clear
    wsDst.Range("A1:D1").Value = Array("Identifiant", "Le Mot", "N° ligne", "Texte identité")
 
    ' Dernière ligne de l'onglet solution
    lastRow = wsSrc.Cells(wsSrc.Rows.Count, "A").End(xlUp).Row
 
    ' Initialiser dictionnaire
    Set dict = CreateObject("Scripting.Dictionary")
 
    ' Initialiser Regex
    Set reg = CreateObject("VBScript.RegExp")
    reg.IgnoreCase = True
    reg.Global = True
 
    currentMot = ""   ' mot courant provenant de la cellule numérique au-dessus des paquets
 
    ' Boucle sur toutes les lignes : on met à jour currentMot quand on rencontre un nombre,
    ' puis quand on rencontre >sp on utilise currentMot et la regex pour tester la ligne <c suivante.
    For i = 1 To lastRow
        Dim cellText As String
        cellText = CStr(wsSrc.Cells(i, 1).Value)
     
        ' Si on trouve une cellule numérique -> c'est le "mot" de contexte
        If IsNumeric(Trim(cellText)) Then
            currentMot = Trim(cellText)
            ' Mettre à jour le pattern regex (sans \b pour détecter 2726 collé)
            If Len(currentMot) > 0 Then
                reg.Pattern = currentMot
            Else
                reg.Pattern = ""    ' pas de motif
            End If
     
        ' Si on tombe sur une ligne identité >sp
        ElseIf Left(cellText, 3) = ">sp" Then
            ligneIdentite = cellText
            ta = Split(ligneIdentite, "|")(1)    ' ex: Q9UBK8.3
            tb = Split(ta, ".")(0)               ' ex: Q9UBK8
            If Len(tb) >= 2 Then
                idCourant = Mid(tb, 1, Len(tb) - 1)  ' ex: Q9UBK
            Else
                idCourant = tb
            End If
         
            ' Vérifier la ligne <c qui suit (si existante)
            If i + 1 <= lastRow Then
                Dim dataText As String
                dataText = CStr(wsSrc.Cells(i + 1, 1).Value)
             
                ' Si on a un pattern défini, tester la présence du mot dans la ligne <c
                If Len(currentMot) > 0 And reg.Pattern <> "" Then
                    If reg.Test(dataText) Then
                        ' Exécuter les matches et mettre en forme chaque occurrence
                        Set Matches = reg.Execute(dataText)
                        For Each m In Matches
                            ' m.FirstIndex est 0-based -> +1 pour Characters()
                            With wsSrc.Cells(i + 1, 1).Characters(m.FirstIndex + 1, Len(m.Value)).Font
                                .Bold = True
                                .Name = "Calibri"
                                .Size = 14
                                .Color = vbRed
                            End With
                        Next m
                    End If
                End If
            End If
         
            ' Stocker dans le dict : mot|ligne
            ' Si pas de mot courant, on stocke une chaîne vide pour la colonne "Le Mot"
            If currentMot = "" Then currentMot = ""
         
            If Not dict.Exists(idCourant) Then
                dict.Add idCourant, currentMot & "|" & i
            Else
                dict(idCourant) = dict(idCourant) & "," & currentMot & "|" & i
            End If
        End If
    Next i
 
    ' Copier les clés dans un tableau pour trier
    If dict.Count = 0 Then
        MsgBox "Aucun identifiant trouvé.", vbInformation
        Exit Sub
    End If
    arrKeys = dict.Keys
 
    ' Tri alphabétique simple (bubble sort)
    For i = LBound(arrKeys) To UBound(arrKeys) - 1
        For k = i + 1 To UBound(arrKeys)
            If arrKeys(i) > arrKeys(k) Then
                tmp = arrKeys(i)
                arrKeys(i) = arrKeys(k)
                arrKeys(k) = tmp
            End If
        Next k
    Next i
 
    ' Écriture dans la feuille doublons (seulement les clés avec plusieurs occurrences)
    outRow = 2
    For i = LBound(arrKeys) To UBound(arrKeys)
        If InStr(dict(arrKeys(i)), ",") > 0 Then
            lignes = Split(dict(arrKeys(i)), ",")
            For idx = LBound(lignes) To UBound(lignes)
                Dim parts() As String
                parts = Split(lignes(idx), "|")
                wsDst.Cells(outRow, 1).Value = arrKeys(i)                ' Identifiant
                wsDst.Cells(outRow, 2).Value = parts(0)                 ' Le Mot (peut être "")
                wsDst.Cells(outRow, 3).Value = CLng(parts(1))           ' N° ligne
                wsDst.Cells(outRow, 4).Value = wsSrc.Cells(CLng(parts(1)), 1).Value ' Texte identité
                outRow = outRow + 1
            Next idx
            outRow = outRow + 1 ' séparation entre groupes
        End If
    Next i
 
    MsgBox "Extraction doublons terminée. " & outRow - 2 & " lignes listées.", vbInformation

End Sub
[/CODE
[/QUOTE]

Cliquez pour agrandir...

laurent950 à dit:

Bonjour Le Forum @finarobert

VBA avec votre fichier en Poste #2

VB:

Sub Programme2Bis_Doublons_Regex_Mot()

    Dim wsSrc As Worksheet, wsDst As Worksheet
    Dim lastRow As Long, i As Long, outRow As Long
    Dim idCourant As String, ligneIdentite As String
    Dim dict As Object
    Dim ta As String, tb As String
    Dim arrKeys() As Variant, k As Long
    Dim tmp As Variant
    Dim currentMot As String
    Dim lignes() As String, idx As Long
  
    Dim reg As Object, Matches As Object, m As Object
  
    ' Feuilles
    Set wsSrc = ThisWorkbook.Sheets("solution")
    On Error Resume Next
    Set wsDst = ThisWorkbook.Sheets("doublons")
    On Error GoTo 0
    If wsDst Is Nothing Then
        Set wsDst = ThisWorkbook.Sheets.Add
        wsDst.Name = "doublons"
    End If
  
    ' Effacer l'onglet résultats
    wsDst.Cells.Clear
    wsDst.Range("A1:D1").Value = Array("Identifiant", "Le Mot", "N° ligne", "Texte identité")
  
    ' Dernière ligne de l'onglet solution
    lastRow = wsSrc.Cells(wsSrc.Rows.Count, "A").End(xlUp).Row
  
    ' Initialiser dictionnaire
    Set dict = CreateObject("Scripting.Dictionary")
  
    ' Initialiser Regex
    Set reg = CreateObject("VBScript.RegExp")
    reg.IgnoreCase = True
    reg.Global = True
  
    currentMot = ""   ' mot courant provenant de la cellule numérique au-dessus des paquets
  
    ' Boucle sur toutes les lignes : on met à jour currentMot quand on rencontre un nombre,
    ' puis quand on rencontre >sp on utilise currentMot et la regex pour tester la ligne <c suivante.
    For i = 1 To lastRow
        Dim cellText As String
        cellText = CStr(wsSrc.Cells(i, 1).Value)
      
        ' Si on trouve une cellule numérique -> c'est le "mot" de contexte
        If IsNumeric(Trim(cellText)) Then
            currentMot = Trim(cellText)
            ' Mettre à jour le pattern regex (sans \b pour détecter 2726 collé)
            If Len(currentMot) > 0 Then
                reg.Pattern = currentMot
            Else
                reg.Pattern = ""    ' pas de motif
            End If
      
        ' Si on tombe sur une ligne identité >sp
        ElseIf Left(cellText, 3) = ">sp" Then
            ligneIdentite = cellText
            ta = Split(ligneIdentite, "|")(1)    ' ex: Q9UBK8.3
            tb = Split(ta, ".")(0)               ' ex: Q9UBK8
            If Len(tb) >= 2 Then
                idCourant = Mid(tb, 1, Len(tb) - 1)  ' ex: Q9UBK
            Else
                idCourant = tb
            End If
          
            ' Vérifier la ligne <c qui suit (si existante)
            If i + 1 <= lastRow Then
                Dim dataText As String
                dataText = CStr(wsSrc.Cells(i + 1, 1).Value)
              
                ' Si on a un pattern défini, tester la présence du mot dans la ligne <c
                If Len(currentMot) > 0 And reg.Pattern <> "" Then
                    If reg.Test(dataText) Then
                        ' Exécuter les matches et mettre en forme chaque occurrence
                        Set Matches = reg.Execute(dataText)
                        For Each m In Matches
                            ' m.FirstIndex est 0-based -> +1 pour Characters()
                            With wsSrc.Cells(i + 1, 1).Characters(m.FirstIndex + 1, Len(m.Value)).Font
                                .Bold = True
                                .Name = "Calibri"
                                .Size = 14
                                .Color = vbRed
                            End With
                        Next m
                    End If
                End If
            End If
          
            ' Stocker dans le dict : mot|ligne
            ' Si pas de mot courant, on stocke une chaîne vide pour la colonne "Le Mot"
            If currentMot = "" Then currentMot = ""
          
            If Not dict.Exists(idCourant) Then
                dict.Add idCourant, currentMot & "|" & i
            Else
                dict(idCourant) = dict(idCourant) & "," & currentMot & "|" & i
            End If
        End If
    Next i
  
    ' Copier les clés dans un tableau pour trier
    If dict.Count = 0 Then
        MsgBox "Aucun identifiant trouvé.", vbInformation
        Exit Sub
    End If
    arrKeys = dict.Keys
  
    ' Tri alphabétique simple (bubble sort)
    For i = LBound(arrKeys) To UBound(arrKeys) - 1
        For k = i + 1 To UBound(arrKeys)
            If arrKeys(i) > arrKeys(k) Then
                tmp = arrKeys(i)
                arrKeys(i) = arrKeys(k)
                arrKeys(k) = tmp
            End If
        Next k
    Next i
  
    ' Écriture dans la feuille doublons (seulement les clés avec plusieurs occurrences)
    outRow = 2
    For i = LBound(arrKeys) To UBound(arrKeys)
        If InStr(dict(arrKeys(i)), ",") > 0 Then
            lignes = Split(dict(arrKeys(i)), ",")
            For idx = LBound(lignes) To UBound(lignes)
                Dim parts() As String
                parts = Split(lignes(idx), "|")
                wsDst.Cells(outRow, 1).Value = arrKeys(i)                ' Identifiant
                wsDst.Cells(outRow, 2).Value = parts(0)                 ' Le Mot (peut être "")
                wsDst.Cells(outRow, 3).Value = CLng(parts(1))           ' N° ligne
                wsDst.Cells(outRow, 4).Value = wsSrc.Cells(CLng(parts(1)), 1).Value ' Texte identité
                outRow = outRow + 1
            Next idx
            outRow = outRow + 1 ' séparation entre groupes
        End If
    Next i
  
    MsgBox "Extraction doublons terminée. " & outRow - 2 & " lignes listées.", vbInformation

End Sub

Cliquez pour agrandir...

finarobert à dit:

je me rends compte que jje n'ai pas tenu compte de Poste#1 et Poste#2. Pouvez-vous me dire la différence?

Cliquez pour agrandir...

TooFatBoy à dit:

Quand on parle de "poste#1" ou "message #1" ou tout simplement "#1", ça correspond au premier message dans ce fil de discussion.
De même, "#2" correspond au deuxième message dans ce fil de discussion. Etc.
Si tu regardes en haut à droite de chaque réponse, tu verras inscrit le numéro du message. Celui-ci est le message #48.

Laurent parlait du fichier de ton message #1, mais il se trompait puisqu'il n'y a aucun fichier dans #1. Le fichier en question est dans #2.

Tout ceci est-il bien clair maintenant ?

Cliquez pour agrandir...

finarobert à dit:

J'ai revu un peu tout et nettoyer mes fichiers

Cliquez pour agrandir...

Sub Programme1Ter_Semblables_Objets()

    Dim wsSrc As Worksheet, wsDst As Worksheet
    Dim lastRow As Long, outRow As Long
    Dim reg As Object, Matches As Object, Match As Object
    Dim ligne As Range
    Dim mot As String
 
    ' Initialisation reg
    Set reg = CreateObject("VBScript.RegExp")
    reg.IgnoreCase = True
    reg.Global = True

    ' Feuilles
    Set wsSrc = ThisWorkbook.Sheets("solution")
    On Error Resume Next
    Set wsDst = ThisWorkbook.Sheets("semblables")
    On Error GoTo 0
    If wsDst Is Nothing Then
        Set wsDst = ThisWorkbook.Sheets.Add
        wsDst.Name = "semblables"
    End If

    ' Effacer l'onglet résultats
    wsDst.Cells.Clear
    wsDst.Range("A1:D1").Value = Array("Mot", "N° ligne", "Nombre", "Identité")
    outRow = 2

    ' Déterminer la dernière ligne
    lastRow = wsSrc.Cells(wsSrc.Rows.Count, "A").End(xlUp).Row

    ' Boucle sur toutes les lignes de la colonne A
    For Each ligne In wsSrc.Range("A1:A" & lastRow)
        Select Case True
            ' Si c'est un mot
            'Case Left(ligne.Value, 3) <> ">sp" And Left(ligne.Value, 2) <> "<c"
             Case Left(ligne.Value, 1) <> ">" And Left(ligne.Value, 1) <> "<"
                mot = Trim(ligne.Value)
                reg.Pattern = mot

            ' Si c'est une séquence <c> précédée d'un >sp
            Case ligne.Row > 2 And Left(ligne.Value, 2) = "<c" And Left(ligne.Offset(-1, 0).Value, 3) = ">sp"
                If reg.Pattern <> "" And reg.Test(ligne.Value) Then
                    Set Matches = reg.Execute(ligne.Value)

                    ' Mise en forme dans "solution"
                    For Each Match In Matches
                        With ligne.Characters(Match.FirstIndex + 1, Match.Length).Font
                            .Bold = True
                            .Name = "Calibri"
                            .Size = 14
                        End With
                    Next Match

                    ' Reporter si plus d'une occurrence
                    If Matches.Count > 1 Then
                        wsDst.Cells(outRow, 1).Value = mot
                        wsDst.Cells(outRow, 2).Value = ligne.Row - 1         ' n° ligne identité
                        wsDst.Cells(outRow, 3).Value = Matches.Count         ' Nombres
                        wsDst.Cells(outRow, 4).Value = ligne.Offset(-1, 0).Value ' Identité
                        outRow = outRow + 1

                        ' Mise en rouge
                        For Each Match In Matches
                            With ligne.Characters(Match.FirstIndex + 1, Match.Length).Font
                                .Bold = True
                                .Name = "Calibri"
                                .Size = 14
                                .Color = vbRed
                            End With
                        Next Match
                    End If
                End If
        End Select
    Next ligne

    MsgBox "Extraction terminée. " & outRow - 2 & " résultats trouvés.", vbInformation

End Sub

<1b2c3b212a2cb563520342bba82b547454211bb43ba5204241216b8502b46b8b515123312bc55b32c135ab2b35135c2b2bb3b53bb21b13cb2b042c3bb25cc14324647c4a0b32025a4430b4aa4

Cliquez pour agrandir...

Sub ExtraireObjetsSemblables_Dict()

    Dim srcSheet As Worksheet, destSheet As Worksheet
    Dim lastRow As Long, outputRow As Long
    Dim ligneCell As Range
    Dim dict As Object
    Dim key As String

    ' Créer le dictionnaire
    Set dict = CreateObject("Scripting.Dictionary")

    ' Feuilles source et destination
    Set srcSheet = ThisWorkbook.Sheets("solution")
    On Error Resume Next
    Set destSheet = ThisWorkbook.Sheets("semblables")
    On Error GoTo 0
  
    If destSheet Is Nothing Then
        Set destSheet = ThisWorkbook.Sheets.Add
        destSheet.Name = "semblables"
    End If
  
    ' Nettoyage de la feuille destination
    destSheet.Cells.Clear
    destSheet.Range("A1:D1").Value = Array("Mot", "N° ligne", "Nombre", "Identité")
    outputRow = 2

    ' Dernière ligne de la colonne A
    lastRow = srcSheet.Cells(srcSheet.Rows.Count, "A").End(xlUp).Row

    ' Remplir le dictionnaire
    For Each ligneCell In srcSheet.Range("A1:A" & lastRow)
        If Left(ligneCell.Value, 3) <> ">sp" And Left(ligneCell.Value, 2) <> "<c" Then
            key = CStr(ligneCell.Row)
            dict(key) = ligneCell.Value
        End If
    Next ligneCell

    ' Écrire les résultats
    Dim k As Variant
    For Each k In dict.Keys
        If Left(dict(k), 1) = ">" Or Left(dict(k), 1) = "<" Then
            destSheet.Cells(outputRow, 1).Value = dict(k)
            destSheet.Cells(outputRow, 2).Value = k
            outputRow = outputRow + 1
        End If
    Next k

    MsgBox "Extraction terminée. " & outputRow - 2 & " résultats trouvés.", vbInformation

End Sub

' Classe CItem
Public key As String
Public Valeur As Variant

Sub ExtraireObjetsSemblables()

    Dim srcSheet As Worksheet, destSheet As Worksheet
    Dim lastRow As Long, outputRow As Long
    Dim ligneCell As Range
    Dim objItem As CItem
    Dim itemsCollection As Collection
    Dim elem As Variant

    ' Initialisation de la collection
    Set itemsCollection = New Collection
  
    ' Feuilles source et destination
    Set srcSheet = ThisWorkbook.Sheets("solution")
    On Error Resume Next
    Set destSheet = ThisWorkbook.Sheets("semblables")
    On Error GoTo 0
  
    If destSheet Is Nothing Then
        Set destSheet = ThisWorkbook.Sheets.Add
        destSheet.Name = "semblables"
    End If
  
    ' Effacer le contenu de la feuille destination
    destSheet.Cells.Clear
    destSheet.Range("A1:D1").Value = Array("Mot", "N° ligne", "Nombre", "Identité")
    outputRow = 2

    ' Déterminer la dernière ligne de la colonne A
    lastRow = srcSheet.Cells(srcSheet.Rows.Count, "A").End(xlUp).Row

    ' Boucle pour remplir la collection avec les items
    For Each ligneCell In srcSheet.Range("A1:A" & lastRow)
        If Left(ligneCell.Value, 3) <> ">sp" And Left(ligneCell.Value, 2) <> "<c" Then
            Set objItem = New CItem
            objItem.Valeur = ligneCell.Value
            objItem.key = CStr(ligneCell.Row)
            itemsCollection.Add objItem
        End If
    Next ligneCell

    ' Boucle pour écrire les résultats dans la feuille destination
    For Each elem In itemsCollection
        Set objItem = elem
        If Left(objItem.Valeur, 1) = ">" Or Left(objItem.Valeur, 1) = "<" Then
            destSheet.Cells(outputRow, 1).Value = objItem.Valeur
            destSheet.Cells(outputRow, 2).Value = objItem.key
            outputRow = outputRow + 1
        End If
    Next elem

    MsgBox "Extraction terminée. " & outputRow - 2 & " résultats trouvés.", vbInformation

End Sub

laurent950 à dit:

Bonjour @finarobert

Le code qui permet de detecter :
- la ligne 150 de votre fichier Excel "etape2vbacandidat2.xlsm" en Poste #50

====================================================================================
Code 1 (Variante avec DICTIONARY)
Avec l'objet Scripting.Dictionary (Sans Module de classe associer au module standard : ExtraireObjetsSemblables_Dict)

Code:

Sub ExtraireObjetsSemblables_Dict()

    Dim srcSheet As Worksheet, destSheet As Worksheet
    Dim lastRow As Long, outputRow As Long
    Dim ligneCell As Range
    Dim dict As Object
    Dim key As String

    ' Créer le dictionnaire
    Set dict = CreateObject("Scripting.Dictionary")

    ' Feuilles source et destination
    Set srcSheet = ThisWorkbook.Sheets("solution")
    On Error Resume Next
    Set destSheet = ThisWorkbook.Sheets("semblables")
    On Error GoTo 0
 
    If destSheet Is Nothing Then
        Set destSheet = ThisWorkbook.Sheets.Add
        destSheet.Name = "semblables"
    End If
 
    ' Nettoyage de la feuille destination
    destSheet.Cells.Clear
    destSheet.Range("A1:D1").Value = Array("Mot", "N° ligne", "Nombre", "Identité")
    outputRow = 2

    ' Dernière ligne de la colonne A
    lastRow = srcSheet.Cells(srcSheet.Rows.Count, "A").End(xlUp).Row

    ' Remplir le dictionnaire
    For Each ligneCell In srcSheet.Range("A1:A" & lastRow)
        If Left(ligneCell.Value, 3) <> ">sp" And Left(ligneCell.Value, 2) <> "<c" Then
            key = CStr(ligneCell.Row)
            dict(key) = ligneCell.Value
        End If
    Next ligneCell

    ' Écrire les résultats
    Dim k As Variant
    For Each k In dict.Keys
        If Left(dict(k), 1) = ">" Or Left(dict(k), 1) = "<" Then
            destSheet.Cells(outputRow, 1).Value = dict(k)
            destSheet.Cells(outputRow, 2).Value = k
            outputRow = outputRow + 1
        End If
    Next k

    MsgBox "Extraction terminée. " & outputRow - 2 & " résultats trouvés.", vbInformation

End Sub

' ====================================================================================
Code 2 (Variante avec Collection + Module de Classe CItem)
Avec l'Objet Collection + Module de Classe CItem associer au (module standard : ExtraireObjetsSemblables)
Module de classe : CItem

Code:

' Classe CItem
Public key As String
Public Valeur As Variant

module standard : ExtraireObjetsSemblables (associer : Module de Classe CItem)

Code:

Sub ExtraireObjetsSemblables()

    Dim srcSheet As Worksheet, destSheet As Worksheet
    Dim lastRow As Long, outputRow As Long
    Dim ligneCell As Range
    Dim objItem As CItem
    Dim itemsCollection As Collection
    Dim elem As Variant

    ' Initialisation de la collection
    Set itemsCollection = New Collection
 
    ' Feuilles source et destination
    Set srcSheet = ThisWorkbook.Sheets("solution")
    On Error Resume Next
    Set destSheet = ThisWorkbook.Sheets("semblables")
    On Error GoTo 0
 
    If destSheet Is Nothing Then
        Set destSheet = ThisWorkbook.Sheets.Add
        destSheet.Name = "semblables"
    End If
 
    ' Effacer le contenu de la feuille destination
    destSheet.Cells.Clear
    destSheet.Range("A1:D1").Value = Array("Mot", "N° ligne", "Nombre", "Identité")
    outputRow = 2

    ' Déterminer la dernière ligne de la colonne A
    lastRow = srcSheet.Cells(srcSheet.Rows.Count, "A").End(xlUp).Row

    ' Boucle pour remplir la collection avec les items
    For Each ligneCell In srcSheet.Range("A1:A" & lastRow)
        If Left(ligneCell.Value, 3) <> ">sp" And Left(ligneCell.Value, 2) <> "<c" Then
            Set objItem = New CItem
            objItem.Valeur = ligneCell.Value
            objItem.key = CStr(ligneCell.Row)
            itemsCollection.Add objItem
        End If
    Next ligneCell

    ' Boucle pour écrire les résultats dans la feuille destination
    For Each elem In itemsCollection
        Set objItem = elem
        If Left(objItem.Valeur, 1) = ">" Or Left(objItem.Valeur, 1) = "<" Then
            destSheet.Cells(outputRow, 1).Value = objItem.Valeur
            destSheet.Cells(outputRow, 2).Value = objItem.key
            outputRow = outputRow + 1
        End If
    Next elem

    MsgBox "Extraction terminée. " & outputRow - 2 & " résultats trouvés.", vbInformation

End Sub

Cliquez pour agrandir...

chris à dit:

Bonjour

Ce qui est rassurant c'est que les 2 solutions aboutissent aux même résultats...

Cliquez pour agrandir...