XL 2016 travail sur tableau

finarobert · Jeudi à 21:50

bonsoir
je cherche à faire deux programmes.
je possède un tableau excel avec 3 onglets : solutions, semblables et doublons (voir fichier joint)
l'onglet solutions est l'onglet de base et connu. Il n'y a que la première colonne d'alimenté. Comment est-elle construite?
Il y a des mots (voir 2726 en A1, 6746 en A184) et en dessous des paquets de 2 lignes avec la première ligne qui commence par >sp, c'est la ligne identité et une deuxième ligne qui commence par >c. Cette deuxième ligne porte les données de la ligne 1 qui comporte le mot en question (2726 en A1), on met alors ce mot en caractère gras.
onglet "semblables"
premier programme : on retrouve toutes les lignes identités qui ont au moins 2 mots dans leur ligne de données
deuxième programme : onglet doublons. Plus compliqué. le début de la ligne identité commence par une structure genre <sp IAb3DE.4 I. Deux identités sont considérés identiques sont sont considérés doublons lorsque les caractères voir exemple Ab3D sont identiques. On commence au premier caractère après la barre I et on finit à l'avant dernier caractère avant le point (D dans l'exemple)
merci pour le coup de main
Robert

finarobert · Hier à 23:15

bonsoir Chris, à propos de l'onglet Semblables : je fais un copie-coller pour remplacer le tableau en solutions_C. je relance la requete de l'onglet semblable et ma colonne 2 s'élargit avec des données qui se mettent en plus dans cette colonne. Je mets un exemple en fichier joint. Cordialement
Robert

finarobert · Hier à 23:17

bon, il me dit fichier trop gros

TooFatBoy · Hier à 23:21

finarobert à dit:
bon, il me dit fichier trop gros

Limite : 1 Mio

finarobert · Hier à 23:27

c'est la colonne 1 qui s'élargit

TooFatBoy · Hier à 23:31

finarobert à dit:
c'est la colonne 1 qui s'élargit

Je croyais que tu voulais poster ton classeur et qu'il était trop gros. 🙁

finarobert · Hier à 23:58

la colonne qui s'élargit, c'est réglé. C'est une ligne de solution_C mal écrite

laurent950 · Aujourd'hui à 00:00

Bonjour Le Forum @finarobert

finarobert à dit:
premier programme : on retrouve toutes les lignes identités qui ont au moins 2 mots dans leur ligne de données

VBA avec votre fichier en Poste #1

VB:

Sub Programme1_Semblables_Regex()


Dim wsSrc As Worksheet, wsDst As Worksheet
Dim lastRow As Long, i As Long, outRow As Long
Dim mot As String

Dim reg As Object
Dim Matches As Object
Dim Match As Object

' 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

' Titres
wsDst.Range("A1:C1").Value = Array("Mot", "N° ligne", "Nombre", "Identité")
outRow = 2

' Dernière ligne de l'onglet solutions
lastRow = wsSrc.Cells(wsSrc.Rows.Count, "A").End(xlUp).Row

' Boucle sur les lignes de solutions
i = 1
Do While i <= lastRow
    ' Si c'est un mot (ni >sp ni >c)
    If Left(wsSrc.Cells(i, 1).Value, 3) <> ">sp" And Left(wsSrc.Cells(i, 1).Value, 2) <> ">c" Then
        If IsNumeric(Trim(wsSrc.Cells(i, 1).Value)) Then
            ' Ici, mot est bien un nombre et on peut continuer
                mot = Trim(wsSrc.Cells(i, 1).Value)
            ' Construire le pattern reg avec délimiteurs de mots
                reg.Pattern = mot
        End If
      
        ' Avancer dans les paquets >sp + >c
        Do While i + 2 <= lastRow And Left(wsSrc.Cells(i + 1, 1).Value, 3) = ">sp" And Left(wsSrc.Cells(i + 2, 1).Value, 2) = "<c"
            ' Vérifier si la ligne >c contient le mot courant avec reg
            If reg.Test(wsSrc.Cells(i + 2, 1).Value) Then
               Set Matches = reg.Execute(wsSrc.Cells(i + 2, 1).Value)
               ' --- Mettre en forme le mot trouvé dans la feuille solution ---
                    For Each Match In Matches
                            With wsSrc.Cells(i + 2, 1).Characters(Match.Firstindex + 1, Match.Length).Font
                                .Bold = True
                                .Name = "Calibri"
                                .Size = 14
                            End With
                    Next Match
            
               If Matches.Count > 1 Then
                ' Reporter dans l'onglet semblables
                    wsDst.Cells(outRow, 1).Value = mot
                    wsDst.Cells(outRow, 2).Value = i + 1                       ' n° ligne de l'identité
                    wsDst.Cells(outRow, 3).Value = Matches.Count                       ' Nombres
                    wsDst.Cells(outRow, 4).Value = wsSrc.Cells(i + 1, 1).Value ' texte identité
                    outRow = outRow + 1
                    ' ---------------------------------------------------------------
                    ' --- Mettre en forme le mot trouvé dans la feuille solution ---
                    For Each Match In Matches
                            With wsSrc.Cells(i + 2, 1).Characters(Match.Firstindex + 1, Match.Length).Font
                                .Bold = True
                                .Name = "Calibri"
                                .Size = 14
                                .Color = vbRed
                            End With
                    Next Match
                    ' ---------------------------------------------------------------
                End If
            End If
            i = i + 2
        Loop
    End If
    i = i + 1
Loop
MsgBox "Extraction terminée. " & outRow - 2 & " résultats trouvés.", vbInformation
End Sub

laurent950 · Aujourd'hui à 00:01

Bonjour Le Forum @finarobert

finarobert à dit:
deuxième programme : onglet doublons. Plus compliqué. le début de la ligne identité commence par une structure genre <sp IAb3DE.4 I. Deux identités sont considérés identiques sont sont considérés doublons lorsque les caractères voir exemple Ab3D sont identiques. On commence au premier caractère après la barre I et on finit à l'avant dernier caractère avant le point (D dans l'exemple)

VBA avec votre fichier en Poste #1

Code:

Sub Programme2_Doublons()

    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
  
    ' 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:C1").Value = Array("Identifiant", "N° ligne", "Texte identité")
  
    ' Dernière ligne de l'onglet solutions
    lastRow = wsSrc.Cells(wsSrc.Rows.Count, "A").End(xlUp).Row
  
    ' Initialiser dictionnaire
    Set dict = CreateObject("Scripting.Dictionary")
  
    ' Boucle sur les lignes de solutions
    For i = 1 To lastRow
        If Left(wsSrc.Cells(i, 1).Value, 3) = ">sp" Then
            ligneIdentite = wsSrc.Cells(i, 1).Value
            ta = Split(ligneIdentite, "|")(1)
            tb = Split(ta, ".")(0)
            idCourant = Mid(tb, 1, Len(tb) - 1)
          
            If Not dict.Exists(idCourant) Then
                dict.Add idCourant, i
            Else
                ' Marquer les doublons en ajoutant l'index de ligne sous forme "X,Y,Z"
                dict(idCourant) = dict(idCourant) & "," & i
            End If
        End If
    Next i
  
    ' Copier les clés dans un tableau
    arrKeys = dict.Keys
  
    ' Tri alphabétique des clés (bubble sort pour simplicité)
    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
    outRow = 2
    For i = LBound(arrKeys) To UBound(arrKeys)
        If InStr(dict(arrKeys(i)), ",") > 0 Then
            ' Séparer les numéros de lignes regroupés
            Dim lignes() As String
            Dim idx As Long
            lignes = Split(dict(arrKeys(i)), ",")
          
            For idx = LBound(lignes) To UBound(lignes)
                wsDst.Cells(outRow, 1).Value = arrKeys(i)
                wsDst.Cells(outRow, 2).Value = lignes(idx)
                wsDst.Cells(outRow, 3).Value = wsSrc.Cells(CLng(lignes(idx)), 1).Value
                outRow = outRow + 1
            Next idx
            outRow = outRow + 1 ' ligne vide pour séparer les groupes
        End If
    Next i
  
    MsgBox "Extraction doublons terminée. " & outRow - 2 & " lignes listées.", vbInformation

End Sub

finarobert · Aujourd'hui à 00:02

je voulais te renvoyer le fichier par rapport au bug de la colonne élargie mais cela s'est réglé car cela venait d'un bug sur le premier onglet. Donc tout est ok sauf l'histoire du deuxième onglet deuxième colonne où le chiffre indiqué est 1 au dessus. Mais tu as fait un boulot super.
Merci encore
Robert

finarobert · Aujourd'hui à 00:16

laurent950 à dit:

Bonjour Le Forum @finarobert

VBA avec votre fichier en Poste #1

VB:

Sub Programme1_Semblables_Regex()


Dim wsSrc As Worksheet, wsDst As Worksheet
Dim lastRow As Long, i As Long, outRow As Long
Dim mot As String

Dim reg As Object
Dim Matches As Object
Dim Match As Object

' 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

' Titres
wsDst.Range("A1:C1").Value = Array("Mot", "N° ligne", "Nombre", "Identité")
outRow = 2

' Dernière ligne de l'onglet solutions
lastRow = wsSrc.Cells(wsSrc.Rows.Count, "A").End(xlUp).Row

' Boucle sur les lignes de solutions
i = 1
Do While i <= lastRow
    ' Si c'est un mot (ni >sp ni >c)
    If Left(wsSrc.Cells(i, 1).Value, 3) <> ">sp" And Left(wsSrc.Cells(i, 1).Value, 2) <> ">c" Then
        If IsNumeric(Trim(wsSrc.Cells(i, 1).Value)) Then
            ' Ici, mot est bien un nombre et on peut continuer
                mot = Trim(wsSrc.Cells(i, 1).Value)
            ' Construire le pattern reg avec délimiteurs de mots
                reg.Pattern = mot
        End If
     
        ' Avancer dans les paquets >sp + >c
        Do While i + 2 <= lastRow And Left(wsSrc.Cells(i + 1, 1).Value, 3) = ">sp" And Left(wsSrc.Cells(i + 2, 1).Value, 2) = "<c"
            ' Vérifier si la ligne >c contient le mot courant avec reg
            If reg.Test(wsSrc.Cells(i + 2, 1).Value) Then
               Set Matches = reg.Execute(wsSrc.Cells(i + 2, 1).Value)
               ' --- Mettre en forme le mot trouvé dans la feuille solution ---
                    For Each Match In Matches
                            With wsSrc.Cells(i + 2, 1).Characters(Match.Firstindex + 1, Match.Length).Font
                                .Bold = True
                                .Name = "Calibri"
                                .Size = 14
                            End With
                    Next Match
           
               If Matches.Count > 1 Then
                ' Reporter dans l'onglet semblables
                    wsDst.Cells(outRow, 1).Value = mot
                    wsDst.Cells(outRow, 2).Value = i + 1                       ' n° ligne de l'identité
                    wsDst.Cells(outRow, 3).Value = Matches.Count                       ' Nombres
                    wsDst.Cells(outRow, 4).Value = wsSrc.Cells(i + 1, 1).Value ' texte identité
                    outRow = outRow + 1
                    ' ---------------------------------------------------------------
                    ' --- Mettre en forme le mot trouvé dans la feuille solution ---
                    For Each Match In Matches
                            With wsSrc.Cells(i + 2, 1).Characters(Match.Firstindex + 1, Match.Length).Font
                                .Bold = True
                                .Name = "Calibri"
                                .Size = 14
                                .Color = vbRed
                            End With
                    Next Match
                    ' ---------------------------------------------------------------
                End If
            End If
            i = i + 2
        Loop
    End If
    i = i + 1
Loop
MsgBox "Extraction terminée. " & outRow - 2 & " résultats trouvés.", vbInformation
End Sub

merci beaucoup. Je le teste demain matin....
cordialement
Robert

finarobert · Aujourd'hui à 00:18

je viens de faire un essai. IL me trouve aucune solution. Bizarre
Robert

finarobert · Aujourd'hui à 00:29

finarobert à dit:
je viens de faire un essai. IL me trouve aucune solution. Bizarre
Robert

ça marche!
merci beaucoup
Robert

chris · Aujourd'hui à 01:11

finarobert à dit:
bonsoir Chris, à propos de l'onglet Semblables : je fais un copie-coller pour remplacer le tableau en solutions_C. je relance la requete de l'onglet semblable et ma colonne 2 s'élargit avec des données qui se mettent en plus dans cette colonne. Je mets un exemple en fichier joint. Cordialement
Robert

Je ne comprends pas trop ce que tu décris.
Le résultat est dans un tableau structuré. Dans les tableau la colonne largeur de la colonne est limitée. J'ai ajouté une options pour que la largeur maxi reste mais ça débordera dans la colonne C si le texte est très long. Mais cela ne crée pas de colonne.
(voir fichier de ma réponse suivante)

chris · Aujourd'hui à 01:20

finarobert à dit:
Bonsoir Chris. bon je vais apprendre le maniement des requetes. Par contre dans les résultats, sur l'onglet Semblables, on obtient toujours un en plus. je prends un ident qui est dans l'onglet, je le récupère dans l'onglet solutions_C. Je copie la ligne de données qui est en dessus por la mettre dans un fichier word, ce qui permet de la voir en entier et à chaque fois j'ai un en moins. Peut-on faire un -1 d'office dans la requête?
merci beaucoup

Au temps pour moi : j'ai oublié effectivement. Corrigé et suppression des lignes qui n'ont qu'une fois le mot.

Fichier modifié pour ces 2 aspects :

Effectuez une recherche sur Excel Downloads...

XL 2016 travail sur tableau

finarobert

XLDnaute Occasionnel

finarobert

XLDnaute Occasionnel

finarobert

XLDnaute Occasionnel

TooFatBoy

XLDnaute Barbatruc

finarobert

XLDnaute Occasionnel

TooFatBoy

XLDnaute Barbatruc

finarobert

XLDnaute Occasionnel

laurent950

XLDnaute Barbatruc

laurent950

XLDnaute Barbatruc

finarobert

XLDnaute Occasionnel

finarobert

XLDnaute Occasionnel

finarobert

XLDnaute Occasionnel

finarobert

XLDnaute Occasionnel

chris

XLDnaute Barbatruc

chris

XLDnaute Barbatruc

Pièces jointes

Discussions similaires

Nous accordons de l'importance à votre vie privée